• 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.

find

Status
Niet open voor verdere reacties.

Symphysodon

Gebruiker
Lid geworden
14 dec 2012
Berichten
468
Beste forummers,

Hier weer een probleem waar ik veel van ga leren denk ik.

Het is de bedoeling dat van een tabblad met een x aantal tabellen bepaalde tabellen (bereiken met lijntjes) worden gekopieerd en netjes onder elkaar met 1 tussenregel worden geplakt in een ander werkblad.

Ik loop vast en kom er niet uit.
Code:
Public Const e1 As String = "tekst1"
Public Const e2 As String = "teskt3"
Public Const e3 As String = "tekst5"

Sub Rapportage_Overzicht()


With Sheets("Data").Range("B2:F450")
    sR = 5
    Set Rng = .Range(.Cells(sR, 2), .Cells(sR + 11, 6))
    For i = 1 To 16
        Set c = .Find(What:="e" & i, LookIn:=xlValues).Row
        If Not c Is Nothing Then
            firstaddress = c.Address

            Do
    
                
            Loop While Not c Is Nothing And c.Address <> firstaddress
        End If
    Next
End With


End Sub

Hopelijk kan iemand mij hiermee helpen.

mvg Marco
 

Bijlagen

  • kopieprobleem.xlsm
    17,3 KB · Weergaven: 22
Beter eerst de typefouten uit het bestand halen.
teskt3 <> tekst3, tekst 5 <> tekst5

Code:
Sub VenA()
  Dim r As Range
  x = Split("tekst1 tekst3 tekst5")
  With Sheets("Data")
    ar = .UsedRange
    For j = 1 To UBound(ar) Step 16
      y = Split(ar(j, 1))
      If IsNumeric(Application.Match(y(UBound(y)), x, 0)) Then
        If r Is Nothing Then Set r = .Cells(j + 4, 1).Resize(13, 6) Else Set r = Union(r, .Cells(j + 4, 1).Resize(13, 6))
      End If
    Next j
  End With
  If Not r Is Nothing Then r.Copy Sheets("Rapport").Cells(1)
End Sub
 
Wat een mooie oplossing. Dank je wel.

Ik begrijp alleen niet helemaal wat Union doet.
 
Heb ik natuurlijk gedaan, begrijp het alleen nog niet.

Komt wel. Bedankt.
 
Mijn voorbeeld was helaas niet gelijkend genoeg want de te zoeken strings zijn niet gelijk van grootte en als ik het goed begrijp kun je split dan niet gebruiken. Ik heb het voorbeeldbestand aangepast.
De zoeken tekst in het voorbeeldbestand is:
tee (kst 1) <> t eeee (kst3) <> tekss (t 5)
 

Bijlagen

  • kopieprobleem.xlsm
    21,1 KB · Weergaven: 18
variant
 

Bijlagen

  • kopieprobleem.xlsm
    30,4 KB · Weergaven: 16
@Ven A De pipe line was de crux. In het voorbeeldbestand werkt het goed. In het te gebruiken bestand nog niet, omdat er in de zoekteksten ook pipe lines voor kunnen komen. De zoekteksten bestaan nl uit aanduidingen voor massa's van isotopen en daar kunnen pipe lines in zitten afhankelijk van een SQ of een TQ meting.

@Cow18 Bedankt ga de code ook testen en bestuderen.
 
Laatst bewerkt:
Onbegrijpelijke reactie. Welke pipeline? Welke grafiek? Als Tabel(X): constant is dan splits je toch op :
 
Ja het is te moeilijk leesbaar mij. Ik weet niet waar je grafiek ziet staan maar het opsplitsen doe je toch met een pipe line (is toch verticaal streepje) en dat werkt dus niet omdat de zoekteksten ook verticale streepjes bevatten.
 
bevatten die ook dubbele punten ?

Definieer je zoekteksten in een array, als strings.
Dan moet je niet meer splitten
Code:
 x = Array("tekst 1,,,,,,,,|||||#}|@", "tekst 3", "tekst 5") 'je 3 tabelomschrijvingen
 
Het is ongelofelijk moeilijk. Ik was er al mee begonnen om de zoekteksten in een array te plaatsen, maar krijg nu een foutmelding bij VenA dat het subscript erbuiten valt. Dat moet dan toch een typefout zijn ergens en bij @cow18 krijg ik een foutmelding op trim: ongeldige eigenschaps toewijzing of onjuist aantal argumenten. In het voorbeeld bestand doen beide codes het goed.
 
En waarom wordt er altijd om een representatief voorbeeld gevraagd? Er is niets moeilijks aan als je eens een poging doet om codes te doorgronden. Al eens van debuggen gehoord?
 
Ik doe mijn best Vena. ik ben hier nou al een paar weken mee bezig zonder bevredigend resultaat en het debuggen waar jij het over hebt geeft vaak alleen maar algemene oplossingen waar je niks mee kan of die niet te volgen zijn. Het voorbeeld van #6 kan bijna niet representatiever. Ik heb letterlijk de tabellen (bereiken met lijntjes) gekopieerd in het voorbeeldbestand.
 
1e macro maakt een tabel aan in tabblad "rapport" met als 2e kolom de cellen die in de B-kolom van "Data" beginnen met "Tabel "
Bu moet je zelf maar iets in de cel er voor zetten om die tabel mee te nemen, een lege cel is dus overslaan !
De 2 macro doet dan het gevraagde.

De bereiken worden bepaald met currentregion, niet met vaste maten zoals bij VenA, welke is beter ?


Sorry, inderdaad, verkeerde bijlage
 

Bijlagen

  • kopieprobleem.xlsm
    32 KB · Weergaven: 36
Laatst bewerkt:
In de bijlage een representatief voorbeeld
De code van cow18 aangepast om de punt in de zoektekst te verwijderen.
Code:
               Ztekst = Mid(tekst, 1, InStr(tekst, ".") - 1)
De code werkt perfect op het voorbeeldbestand maar in mijn bestand krijg ik meteen als ik debug (F8) een foutmelding op "trim".
De code van VenA begrijp ik nog niet goed genoeg om het aan te passen.
 

Bijlagen

  • kopieprobleem.xlsm
    25,9 KB · Weergaven: 21
Zo beter?

Code:
Sub VenA()
  Dim r As Range
  x = Array("tee (kst | 1)", "t eeee (kst3)", "tekk (st 4)")
  With Sheets("Data")
    ar = .UsedRange
    For j = 1 To UBound(ar) Step 16
      y = Split(ar(j, 1), ",")
      If IsNumeric(Application.Match(Trim(Replace(y(UBound(y)), ".", "")), x, 0)) Then
        If r Is Nothing Then Set r = .Cells(j + 4, 1).Resize(13, 6) Else Set r = Union(r, .Cells(j + 4, 1).Resize(13, 6))
      End If
    Next j
  End With
  If Not r Is Nothing Then r.Copy Sheets("Rapport").Cells(1)
End Sub
 
Ja het werkt perfect. Maar nu komt het. Als ik de tabellen van mijn bestand kopieer naar het voorbeeldbestand en ik pas de zoekteksten aan dan werken beide codes zoals het moet, alleen krijg ik nu ook bij VenA in mijn eigen bestand een foutmelding op trim:
Compileerfout Onjuist aantal argumenten of ongeldige eigenschappentoewijzing.

zodra ik de code kopieer naar de module in mijn bestand wordt Trim niet meer herkend en met een kleine letter geschreven????
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan