• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Vastgelopen in zoek/verwijs/kopieer macro

Status
Niet open voor verdere reacties.

robinvdveeken

Gebruiker
Lid geworden
7 sep 2010
Berichten
84
Veelwetende forumleden,

Een nieuw, leuk project waarin ik inmiddels vastloop in de code

Het is de bedoeling dat op tabblad ("IO_ijst") in Kolom E word gezocht naar alle rijen waarin U400 voorkomt.

Deze waarde moet op tabblad ("ET200S") in Rij 4 worden geplakt, mits deze daar niet al staat. Deze kan namelijk vaker voorkomen. De waarde uit Kolom I varrieert dan wel.
De waarde tabblad ("IO_lijst") in Kolom I moet dan in de cellen daaronder worden geplakt in de volgorde.

Het verhaal word vast heel wazig, daarom het voorbeeld bestand :D

Voor de liefhebbers, Hiermee kan de uit Eplan geexporteerde Componentenlijst worden gebruikt om labels voor op een plc te maken.

Tot zover ben ik gekomen met de code:

Code:
Sub WhereIsIt()
    Dim R As Range, FindAddress As String
    Dim Componentregel As Range
    Dim X As Range
    
'init
Set Componentregel = Cells(4, 1)

     'Set the range in which we want to search in
    With Sheets("IO_lijst").Range("E1:E1000")
         'Search for the first occurrence of the item
        Set R = .Find("400U")
         'If a match is found then
        If Not R Is Nothing Then
             'Store the address of the cell where the first match is found in a variable
            FindAddress = R.Address
            Do
                With Range("A4:ZZ4")
            
                .Find (R.Value)=
                
                If R.Value <> Range("A4:ZZ4") Then
                
                Componentregel = R.Value
                              
                Componentregel.Font.Bold = True
               
                End If
               
               Set Componentregel = Componentregel.Offset(0, 2)
                
            
                
                 'Search for the next cell with a matching value
                Set R = .FindNext(R)
                 'Search for all the other occurrences of the item i.e.
                 'Loop as long matches are found, and the address of the cell where a match is found,
                 'is different from the address of the cell where the first match is found (FindAddress)
            Loop While Not R Is Nothing And R.Address <> FindAddress
        End If
    End With
     
     'Clear memory
    Set R = Nothing
     
End Sub

Kan iemand mij helpen?

Alvast bedankt.


Groeten,
Robin
 

Bijlagen

Robin,

Ik vindt het niet gek dat je vastloopt.
Op sheets IO-ijst (IO-lijst) zoeken in kolom E naar alle rijen met U400.
Op die sheet komt nergens iets voor met U400.
In kolom E vindt je maar 1 regel waar zoiets voor kan komen.

Plakken op regel4 van sheet ET200S als die al niet bestaat.
Nou dat is 1x kopiëren en de regel is gevuld en daarna valt er niets meer te kopiëren.

De waarde uit kolom I varieert, waarin, hoe en wat met deze kolom.
Waarde overnemen uit sheet IO-lijst kolom I. Daar staan 2 waarden, welke overnemen.

Je voorbeeld bestand is weinig zeggend, is van geen toegevoegde waarde.

Al met al.

Plaats nou eens een doordachte heldere vraag ipv dit.
Voeg een voorbeeld bestand bij met daarin opmerking wat je waarvandaan waarheen wilt hebben.
 
Laatst bewerkt:
Bedankt voor de reactie Superzeeuw,

Ik waag een nieuwe poging op deze nieuwe dag:

De bijlage is een voorbeeldbestand waarin ik zoveel mogelijk, misschien wel teveel heb weggelaten. Ik was in de veronderstelling dat dit de boel zou verduidelijken. Helaas heb ik de code niet goed aangepast aan het voorbeeld bestand. Mijn Excuses.

Op het tabblad ("IO_lijst") staat een lijst met gegevens welke word geëxporteerd van uit een tekenprogramma Eplan. Deze is in het voorbeeldbestand wat ingekort. De kolomen welke voor de nieuwe functie van belang zijn, dat zijn kolom E en kolom I. Op het tabblad ("ET200S") staan labels welke gegenereerd moeten worden vanuit de gegevens van het tabblad ("IO_lijst"). Ik heb er handmatig twee voorgedaan ter verduidelijking.

In kolom E van het tabblad ("IO_lijst") staat het zo gehete componentnummer van het onderdeel. Elke component krijgt vanuit Eplan een uniek nummer toegewezen. Alle onderdelen van een PLC krijgen een nummer dat begint met "400U" (Let op: niet met "U400") Dit nummer komt voor het eerste label in cel ("A4") te staan. Voor het tweede label in cel ("C4") En zo moet er steeds één kolom worden overgeslagen. De nummers komen meerdere keren voor in kolom E. Ze moeten maar één keer worden toegevoegd en in nummering oplopend. Dit betekend dat het laagste nummer (Laagst mogelijk = 400U0.0) het meest links op het tabblad (“ET200S”) komt te staan, en dus van links naar recht oploopt.

Tot zover geen probleem maar dan komt het.

In kolom I van het tabblad (“IO_lijst”) staan de coderingen van de in- en uitgangen van de PLC. Deze moeten in bij bijhorend componentnummer (kolom E) in het label op tabblad (“ET200S”) worden ingevuld. Hierbij gaat het dus alleen op de coderingen waarvan het componentnummer uit kolom E begint met “400U”. Het laagste nummer moet links boven in, dan rechts boven in, links onder en het hoogste nummer rechts onder. Voor het eerste label is dit de range (“A6:B7”).

Waar ik klem loop is dat er meerdere zoekfuncties door elkaar gaan lopen. Voorbeelden uit de helpfunctie, en mijn beschikbare literatuur rijken ook niet zover.

Ik hoop dat iemand een passend voorbeeld heeft of mij op weg kan helpen met de code.

Alvast bedankt.

Groeten,
Robin
 

Bijlagen

eventjes een beetje anders benaderd :
zie bijlage, ik kan het eventjes neit afmaken, later vandaag
 

Bijlagen

toch eventjes verder gedaan
 

Bijlagen

Bedankt Cow18, dit is kunde!

Het resultaat is nog niet perfect maar dit is zeker de goed weg.
Wat mij als eerste opviel:

In deze loop worden de kaartnummers weggeschreven:
Code:
 For Each c In .Columns("AA").SpecialCells(xlConstants)
      If c.Row > 1 Then
        i = i + 2                                          'kolomnummer bepalen
        ET.Cells(17, i).Value = c.Value                    'kaartnummers wegschrijven naar rij 17
      End If
    Next

Door de For Each word voor alles een kaart nummer gemaakt. Dit moet alleen gebeuren als er "U400" in voorkomt, en dus niet als er "U401" oid staat.

Ik ga er mee aan de slag!

Groeten,
Robin
 
dan hoor ik het wel als er ergens een wiel van de wagen loopt ...
 
Beste Cow18,

Door een extra voorwaarde aan de c variabele toe te voegen dacht ik dat het moest gaan werken.

Code:
 For Each c In .Columns("AA").SpecialCells(xlConstants)
   If c.Row > 1 Then
        If c.Value = "*400U*" Then
            i = i + 2                                          'kolomnummer bepalen
            ET.Cells(17, i).Value = c.Value                    'kaartnummers wegschrijven naar rij 17
        End If
     End If
   Next

Helaas verschijnt er dan een fout melding, de waarde is niet gevonden. Dit ontstaat in het onderste deel van de code. Ik begrijp niet goed wat hier gebeurd.
Toen ik mezelf erop betrapte dat ik argeloos dingen ging proberen dacht ik laat ik het maar even vragen..

Alvast bedankt.

Groeten,
Robin

EDIT: De opmerking die ik er misschien bij moet maken, vanuit Eplan komt een lijst met heel veel codes, alleen de codes (kaartnummers) beginnent met 400U moeten op de labels komen.
 
Laatst bewerkt:
hier een deel van de macro met in het rood de wijzigingen
Code:
    .Columns("AA").Sort key1:=.Range("AA2"), Header:=True  'oplopend sorteren
    For Each c In .Columns("AA").SpecialCells(xlConstants)
      If c.Row > 1 Then
        [COLOR="red"]If InStr(1, c.Value, "400U") > 0 Th[/COLOR]en
          i = i + 2                                        'kolomnummer bepalen
          ET.Cells(17, i).Value = c.Value                  'kaartnummers wegschrijven naar rij 17
        [COLOR="red"]End If[/COLOR]
      End If
    Next
    ET.Rows(17).Copy ET.Rows(30)                           'rij 17 doorkopieren naar rij 30
  End With

  For Each c In IO.Columns("E").SpecialCells(xlConstants)  'loop alle niet-lege cellen in de E-kolom van IO af
    If c.Row > 1 Then                                      'koprij zo laten
      Set d = Nothing: Set d = ET.Rows(17).Find(c.Value, lookat:=xlWhole)  'zoek kaartnummer op
      If d Is Nothing Then
        [COLOR="red"]If Left(c.Value, 4) = "400U" Then [/COLOR]MsgBox c.Value & " is niet gevonden"            'probleempje
      Else
        r = d.MergeArea.Range("A1").Row
        k = d.MergeArea.Range("A1").Column
ik bedacht me plots, die 1e "instr" mag eigenlijk ook gewoon een left(...,4) zijn zoals verder ook gebruikt is. Die instr wasd de letterlijke vertaling van je "*400U*", maar 400U staat altijd links
 
Laatst bewerkt:
Bedankt voor de aanvulling cow18.

Het valt me nu op dat die wijziging het einde betekend voor labels voor de analoge signalen. Helaas heb ik vanaf mijn huis geen toegang tot de Eplan bestanden op mijn werk. Maandag ga ik exact bekijken hoe het zit.

Inmiddels heb ik de code aangepast. Het blauw maken van de juiste cellen is nu ook in de macro verwerkt en de overbodige 2e balk eruit gehaald. Zie bijlage.

Ik zou graag de omlijning ook in de macro verwerken. Hiervoor heb ik het grote bestand waar het geheel in komt aparte Sub's gemaakt. Bijvoorbeeld:

Code:
Sub BorderVerticaal()
'
'
' maakt een dikke border lijn verticaal tussen alle geselecteerde velden
'
With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
End With

End Sub

Er is ook een Sub voor volledige omlijning die onder andere weer bovenstaande Sub bevat:

Code:
 Sub BorderVol()
'
'
' maakt een dikke border lijn rechts van de geselecteerde velden

    BorderRechts
    BorderLinks
    BorderOnder
    BorderBoven
    BorderVerticaal
    BorderHorizontaal
End Sub

Hierdoor is het mogelijk een bepaalde range in simpel van een omlijning te voorzien

Bijvoorbeeld zo:
Code:
 Range("V" & Start_nr + 1 & ":W" & Start_nr + 3).Select
    BorderVol

Dit houd de programmacode lekker kort.

Waar ik tegen aanloop is het aanspreken van een range met een variabele kolom
As integer i

Het moet waarschijnlijk zo iets worden:
Code:
ET.Range(i & "15"& : i + 1 "16").Select
BorderVol

Het komt er op neer dat als i = B
Range B15:C16 omlijnt moet worden.

Dat ik dit niet begrijp blijkt ook wel aan de manier hoe ik de cellen blauw maak in de bijlage :o

Alvast bedankt voor de suggesties.

Groeten,
Robin
 

Bijlagen

Laatst bewerkt:
Code:
ET.Range(Cells(15, i), Cells(16, i + 1)).BorderAround xlContinuous, xlThick, xlAutomatic

Bovenstaande code maakt een dikke rand in het bereik.

Met vriendelijke groet,


Roncancio
 
Vooreerst is het gebruik van samengevoegde cellen vaker een oorzaak van wrevel dan van gemak. dus dat zou ik liever vermijden. Zo begrijp ik niet waarom je 8 rijen nodig hebt om daar maar 2 dingen neer te schrijven Rijen 29:26 kunnen gerust 2 rijen worden.

ik zou eenmalig een volledige opmaak maken voor een gewone digitale I/O-module (voorbeeld B15:C26) en een andere voor een analoge I/O-module (vb AR15:AS26).
Die opmaak zou ik dan tig keer doorkopieren met "plakken-speciaal-opmaak".
 
Weer bedankt voor de reacties!

De ellende van samengevoegde cellen is me bekend uit andere project(jes). Zowaar het voorbeeld eerst handmatig werd ingevuld maakt het natuurlijk niet uit.

Ik ga hier mee aan de slag!

Een goed weekend.

Groeten,
Robin
 
Het werkt tot zover!

Dat de aanduiding voor de analoge kaarten niet in het midden staat word denk ik de nieuwe standaard ;)

Bedankt allemaal!

Groeten,
Robin
 

Bijlagen

misschien toch niet, een paar kleine aanpassingen
PS. een kleine vraag, het is jaren geleden dat ik nog met Siemens-PLCs werkte, toen was het nog S5 ipv S7. Zijn die nieuwe kaarten zo klein of wat scheelt er daar mee. Zijn er bv. geen 32 I/O per kaart ipv 4 ?
 

Bijlagen

Laatst bewerkt:
Bedankt Cow 18,

Het lettertype zal ik ook weer vaststellen in de macro, kleinigheidje.

Over je vraag, Deze macro is voor het type ET200S. Dit is van origine een remote io station, cpu er aangeplakt en nu een kan het als goedkoper alternatief voor de S7-300 serie door het leven. Welliswaar met de helft van de CPU capaciteit.
Eerder was er een ander alternatief, de S7-200 serie. Siemens heeft destijds dit model gekocht van Texas instruments en is deze op dezelfde wijze blijven produceren. Inmiddels is er een vervanger voor de S7-200, de S7-1200. Wel origineel ontwikkeld door Siemens. Het nadeel hiervan is dat deze niet met de normale versie van Step 7 te programmeren is. Enkel met een speciale versie, ik meen V10.5 Deze versie is erg grafisch, een plc programma maken kan je vergelijken met Windows opnieuw instaleren. Ook werken sneltoetsen niet meer. Het grootste bezwaar is dat eerder geschreven materiaal simpelweg niet in deze versie te is te openen. Siemens verwacht dat dit binnen 3 (!) jaar mogelijk is. Applaus :rolleyes:
Al met al een heel verhaal, maar dat is de reden waarom we voor simpele toepassingen nu de ET200S gebruiken.

Groeten,
Robin
 
Toch nog een klein vraagje,

Het zou leuk zijn als er in de bovenste cellen (rij 15,16) het logo van het bedrijf komt te staan voor elke kaart.

Nu was het idee om een pad op te geven waar het bestand staat en het dan in te voegen. Een voorbeel logo in opgegeven cellen zetten kan natuurlijk ook.
Deze code had ik gevonden maar ik kom er niet mee weg

Code:
Dim BestandsLoc As String
Dim AfbNaam As String

BestandsLoc = "P:\logoPLC"

AfbNaam = ActiveCell.Value
AfbNaam = Worksheets("ET200S").Range("O16").Value
Range("O16").Select
InsertPictureInRange BestandsLoc & AfbNaam & ".jpg", _
'Range("H16").Select

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
AfbNaam = Worksheets("Collage").Range("O16").Value

' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Name = AfbNaam
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing

In de bijlage heb ik als voorbeeld even een raar logotje gebruikt.

Kan iemand mij helpen?

Alvast bedankt.

Groeten,
Robin
 

Bijlagen

ik vond het logo maar niets, dus heb ik een ander genomen.
Dat logo staat nu als een variabele bovenin de module, die moet je desnoods maar wijzigen. Verder heb ik enkel rij 16 genomen, per 2 cellen samengevoegd en dan wat zitten spelen met links, top, hoogte en breedte om hem een beetje van de randen af te houden. Daar moet je anders ook maar wat mee spelen
 

Bijlagen

Het is gelukt helemaal top!
De nieuwe uitdaging is het zelfde uitwerken voor een S7-300
Het nadeel, nogmeer mogelijkheden in kaarten.

Bedankt!

Groeten,
Robin
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan