Vergelijk op meerdere bladderen.

[Dokman]

Hallo,

Ik wil en vergelijking maken met meerdere tabbladeren.

Blad1 is het hoofdblad, daar staat alles in wat ik heb. En dan gaat het vooral om de 8-cijferige nummers.

Blad2 tot oneindig daar copier ik en stuk in van en .NC bestand. Daarom zijn de regels ook niet netjes verdeelt over cellen.
Dit hoeft ook niet netjes. Want ik moet de eerste keer over de 100 bestanden knippen en plakken.
En dit soort lijsten met tabbladeren kan oneindig door gaan.

Nu is mijn wens. Dat hij op de tabbladeren gaat kijken welke 8-cijferig nummer ook op blad 1 staat en deze dan en kleurtje geeft. Staat het nummer er niet, dan gewoon wit laten.

Het komt er dus op neer dat hij en vergelijking moet gaan maken. Maar krijg het niet voor elkaar omdat over meerdere bladeren te doen. Alleen als ik heel veel Voorwaardelijke opmaak ga aan maken. Maar denk dat het makkelijker moet kunnen via vba.

 

[edmoor]

Zo?

Sub Catalogus()
    For i = 2 To Sheets("Blad1").Range("A1").End(xlDown).Row
        For Each sh In ThisWorkbook.Sheets
            If sh.Name <> "Blad1" Then
                Set c = sh.Range("A:A").Find(Sheets("Blad1").Cells(i, 1), , , xlPart)
                If Not c Is Nothing Then c.Interior.Color = 65535
            End If
        Next sh
    Next i
End Sub

NB:
Die .NC bestanden kan je wellicht ook eenvoudig middels VBA importeren in plaats van knippen en plakken.

NB2:
Niet tabbladeren maar tabbladen.

 

[Dokman]

Dank je precies wat ik zocht.
Zal hem onder en button plaatsen. Als ik nieuwe nummers invoer moet de script wel op nieuw uitgevoerd worden.

NB:
Mocht jij en manier hebben om het sneller te kunnen het importeren hoor ik dit graag.

NB2:
Zal er op gaan letten.

 

[edmoor]

NB:
Mocht jij en manier hebben om het sneller te kunnen het importeren hoor ik dit graag.

Als je een voorbeeld van een dergelijk bestand hier plaatst wil ik er wel even naar kijken.

 

[Dokman]

Ik heb even en bestand toegevoegd waar ik de informatie uit kopieer.

Het bestand is 6600 regels lang en soms nog langer of korter.
Maar het gaat bij om het eerste stukje alles tussen % en (T-END).

Maar het moet welke elke keer op en nieuw tabblad.

De bestanden hebben altijd de extensie .NC en daar kan ik niets aan veranderen.
Heb het nu deze keer wel gedaan naar .TXT omdat ik anders het bestand niet kan uploaden.

 

[edmoor]

Het gaat dus om een aantal van die bestanden en deze moeten per stuk naar een nieuw werkblad worden gekopieerd?
Staan deze bestanden in een vaste folder?

 

[Dokman]

Wou niet zeggen.
Elk bestand staat in en aparte map. Omdat er nog meer informatie in die map staat.

Ik ben al lang blij als ik de file kan selecteren en dat hij dan de gegevens uit het bestand. In en aparte sheet zet.

 

[edmoor]

Ok, geen probleem.
Zal er naar kijken als ik straks weer terug ben.

 

[Dokman]

Rustig aan vindt het al mooi dat er iemand wil helpen.

 

[AHulpje]

Heb voor de grap eens aan ChatGPT gevraagd een importfunctie te schrijven, bijgaand het resultaat, zie Sub ImportTextFilesFromDirectory. Deze gaat ervan uit dat de te importeren bestand met de extensie .NC allemaal in dezelfde map staan als het Exceldocument en dat werkt vlekkeloos. De functie van Edmoor staat er ook in. Maar ik lees nu dat die bestanden in verschillende mappen staan. Is er een hoofddirectory waar al die mappen onder te vinden zijn? Dan zal ik chatGPT nog eens vragen e.e.a. aan te passen.

 

[AHulpje]

Hm, programmeurs worden bijna overbodig.

 

[Dokman]

Dat is wat ik zoek. Alleen nu opent hij altijd het nieuwe tabblad aan het begin.
Dan valt blad1 op en gegeven moment weg.

 

[edmoor]

En je hebt dan meer dan alleen alles tussen % en (T-END).

 

[AHulpje]

@edmoor
Wat bedoel je daar precies mee?

@Dokman
Met deze wijziging worden de werkbladen aan het eind toegevoegd.

Set Sheet = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))

En als je

Application.Goto Sheets("Blad1").Range("A1")

aan het einde van ImportTextFilesInDirectory toevoegt springt hij naar Blad1.

 

[edmoor]

@edmoor
Wat bedoel je daar precies mee?

Zie de beschrijving in #5.

 

[AHulpje]

@edmoor
Oeps, helemaal overheen gelezen. Eens kijken wat chatGPT vindt?
Hm, chatGPT is niet onfeilbaar, kan niet eens tot tien tellen, ik moest

Left(TextLine, 6) = "(T-END)"

wijzigen in

Left(TextLine, 7) = "(T-END)"

Maar geeft eerlijk toe dat zij ook fouten maakt toen ik haar daarop wees:
"You're absolutely correct! The code should indeed check for the first 7 characters of the line to match (T-END). Thank you for catching that! Let me know if you need further assistance."

 

[Dokman]

ik had zelf ook al gevraagt aan ChatGPT hoe ik (T-END) daar onder alles weg kon krijgen. hij kwam met het volgende.

Sub RemoveDataBelowTEndAllSheets()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim tEndRow As Long
    Dim searchRange As Range
    Dim cell As Range

    ' Loop through each worksheet in the workbook
    For Each ws In ThisWorkbook.Sheets
        ' Define the range to search (assuming data is in Column A)
        Set searchRange = ws.Range("A:A")
        
        ' Initialize tEndRow as 0 for each sheet
        tEndRow = 0
        
        ' Find the row with "T-END" in Column A
        For Each cell In searchRange
            If cell.Value = "T-END" Then
                tEndRow = cell.Row
                Exit For
            End If
        Next cell
        
        ' If "T-END" is found, remove data below it
        If tEndRow > 0 Then
            ' Find the last row with data in the sheet
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            ' Delete rows below "T-END"
            If tEndRow < lastRow Then
                ws.Rows(tEndRow + 1 & ":" & lastRow).Delete
                MsgBox "Data below 'T-END' removed on sheet: " & ws.Name, vbInformation
            Else
                MsgBox "'T-END' is already at the bottom on sheet: " & ws.Name, vbInformation
            End If
        Else
            MsgBox "'T-END' not found on sheet: " & ws.Name, vbExclamation
        End If
    Next ws
End Sub

 

[edmoor]

Dat is achteraf.
Probeer deze eens. Een combinatie van AHulpje en van mij.
Het NC bestand bevat geen CR, alleen LF:

 

[Dokman]

heb gekeken maar hij leest het bestand in maakt en sheet aan. en dan verwijdert die alles onder % en aangezien dat het eerste teken is van het bestand is het best veel wat hij verwijdert.

 

[edmoor]

Bij mij niet.
Bevat jouw NC bestand soms wel CR tekens?
Ik heb je voorbeeld NC bestand gedownload en gebruikt, doe dat eens.