Probleem declaratie Excel variabele Row

Status
Niet open voor verdere reacties.
A

AMBERTJE

Gebruiker
Lid geworden
27 aug 2009
Berichten
121
Hello everybody,

Ik ondervind problemen met dit stukje code.
Elke dag laad ik dmv een andere applicatie een heleboel lijnen in excel, de bovenste lijnen (een 40-tig tal) zijn wel allemaal lege lijnen. (de Excel versie waar ik mee werk is 2003)

Nu wil ik deze lijnen deleten tot de teller een rij tegenkomt waar de waarde "Products" in staat en dan moet de loop stoppen.

Misschien wel raar dat ik de excel objecten heb geïnitialisserd en gedeclareerd maar deze code komt uit een andere applicatie (Scripting) en werd ooit door iemand anders geschreven.
Ik ondervind wel een probleem bij het declareren van het object Row.

Misschien is de opzet van de loop ook niet helemaal juist maar door het probleem met de variabele kan ik niet verder testen.

Kunnen jullie mij zeggen wat ik fout doe aub?

Code: 
Dim xlApp As Excel.Application, xlBook As Excel.Workbook, xlSheet As Excel.Worksheet, xlRange As Excel.Range Dim xlWorkSheetF As Excel.WorksheetFunction

Sub Delete_Rows()
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks("Book3")
    Set xlSheet = xlBook.Worksheets(1)
    Set xlWorkSheetF = xlApp.WorksheetFunction
    Set xlRange = xlSheet.Range("A1")

     With xlSheet
        Dim rij As Integer
        rij = 0
            Do Until xlSheet.Range.Cells.Value <> "Products"
                'xlRange.Cells(1).Value <> "Products"
                Cells.EntireRow.Delete
                'Cells.EntireRow.Select
                'Selection.Delete Shift:=xlUp
                rij = rij + 1
            Loop
     End With
End Sub

Groetjes,
Amber

Opmerking: ik heb een probleem om nieuwe vragen te posten op dit forum als ik op het netwerk ben aangesloten van onze firma.
Dus als ik niet zo snel reageer is dit de reden. (van thuis uit kan ik wel vragen posten)
 
Ik voeg even een zelfgemaakt Excel filetje bij om het 1 en ander te verduidelijken.
Nog even vermelden dat de waardes niet per kolom worden ingelezen maar per rij en dat is de reden waarom de hele lijn in 1 cel staat onder kolom A.

Ik wil enkel de lijnen die boven "Product" staan verwijderen, het aantal lege rijen daarboven is niet altijd hetzelfde.

Groetjes,
Amber
 
Laatst bewerkt:
Probeer deze code:
Sub VerwijderRijen()
Dim C As Range

With Blad1.Columns(1)
Set C = .Find(What:="Product", _
After:=.Cells(1, 1), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not C Is Nothing Then
.Cells(1, 1).Resize(C.Row - 1).EntireRow.Delete
End If
End With
End Sub
Klik om te vergroten...
 
Hoi Amber,

Ik heb deze code voor je gemaakt.
Lees de comments en dan wijst het zichzelf.

controleer wel of de naam "book3" correct werkt, ik moest ook de bestandsextensie opgeven om geen foutmelding te krijgen.

succes.
Mark.

Code: 
Sub RijenVerwijderen()
Dim rngFound As Range
Dim strBookName As String
Dim strFoundAddress As String
Dim strRangetoDelete As String

    'geef hier de naam van de workbook op
    strBookName = "Book3"

    '1 : zoek de cel met de tekst "Products"
    Set rngFound = Workbooks(strBookName).Worksheets(1).Columns(1).Find(What:="Products", _
                                                                Lookat:=xlWhole, _
                                                                LookIn:=xlValues, _
                                                                MatchCase:=False)
    '2. en als dan de cel gevonden is....
    If Not rngFound Is Nothing Then
        
        '...het adres opslaan...
        strFoundAddress = Replace(rngFound.Address, "$", "")
        
        '...controleren of de cel niet A1 is om te voorkomen dat het
        '   te verwijderen gebied buiten het bereik valt...
        If strFoundAddress <> "A1" Then
        
            '... het te verwijderen gebied bepalen...'
            strRangetoDelete = "A1:" & Replace(rngFound.Offset(-1).Address, "$", "")
            '...en alle ongewenste rijen verwijderen.
            Workbooks(strBookName).Sheets(1).Range(strRangetoDelete).EntireRow.Delete 
            '            Klaar!

        End If

    End If

End Sub
 
Laatst bewerkt:
Mark,

Ik heb je code getest:
1. terecht controleer je of er wel rijen te verwijderen zijn
2. met de Find optie "Lockat:=xlWhole" wordt er niets gevonden omdat er in die cel meer tekst staat.

Code: 
Sub VerwijderRijen()
Dim C As Range

With Blad1.Columns(1)
    Set C = .Find(What:="Product", _
        After:=.Cells(1, 1), _
        Lookat:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=True)
    
    If Not C Is Nothing Then
        If C.Row > 1 Then .Cells(1, 1).Resize(C.Row - 1).EntireRow.Delete
    End If
    
End With
End Sub
 
volgens mij is het wel goed.

In de oorspronkelijke code stond
Code: 
Do Until xlSheet.Range.Cells.Value <> "Products"
Dat betekent een exacte match, dus als er geen "Products" aanwezig zou zijn, evalueert die expressie nooit naar True, wat een endless loop zou betekenen.

Let wel op dat je "Products" zoekt, zoals in de eerste post, en niet "Product" want dan vind je inderdaad niets met xlWhole match.

Heb je dat misschien door elkaar gehaald?

Gr,
Mark.
 
Emil S zei:
Mark,

Ik heb je code getest:
1. terecht controleer je of er wel rijen te verwijderen zijn
2. met de Find optie "Lockat:=xlWhole" wordt er niets gevonden omdat er in die cel meer tekst staat.

Code: 
Sub VerwijderRijen()
Dim C As Range

With Blad1.Columns(1)
    Set C = .Find(What:="Product", _
        After:=.Cells(1, 1), _
        Lookat:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=True)
    
    If Not C Is Nothing Then
        If C.Row > 1 Then .Cells(1, 1).Resize(C.Row - 1).EntireRow.Delete
    End If
    
End With
End Sub
Klik om te vergroten...



Hai Emil

Ik ben zo dankbaar dat jullie me willen helpen.
Emil uw code werkt als ik deze test op een werkboek die ik op voorhand al voorbereid heb (zoals het voorbeeld "book3")
Als ik uw code in mijn code integreer loopt het echter mis, vandaar dat ik nog een ander stukje code meegeef waar de excel objecten in declareer en Set.
 
Vandaar,

Dit is dezelfde macro maar dan verdergebouwd op de door u aan gegeven objecten.
Werkt dit naar behoren?

Overigens kun je de macro in mijn eerste post in deze thread gebruiken om dezelfde actie binnen excel uit te voeren.

Code: 
Dim xlApp As Excel.Application, xlBook As Excel.Workbook, xlSheet As Excel.Worksheet, xlRange As Excel.Range
Dim xlWorkSheetF As Excel.WorksheetFunction

Sub Delete_Rows()
Dim rngFound As Excel.Range
Dim strFoundAddress As String
Dim strRangetoDelete As String
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks("Book3")
    Set xlSheet = xlBook.Worksheets(1)
    Set xlWorkSheetF = xlApp.WorksheetFunction
    Set xlRange = xlSheet.Range("A1")
    Set rngFound = xlSheet.Columns(1).Find(What:="Products", _
                                           Lookat:=xlWhole, _
                                           LookIn:=xlValues, _
                                           MatchCase:=False)
    If Not rngFound Is Nothing Then
        
        strFoundAddress = Replace(rngFound.Address, "$", "")

        If strFoundAddress <> "A1" Then
            strRangetoDelete = "A1:" & Replace(rngFound.Offset(-1).Address, "$", "")
            xlSheet.Range(strRangetoDelete).EntireRow.Delete
        End If

    End If

End Sub
 
Laatst bewerkt:
Dag Mark,

Ik heb uw code uitgeprobeerd maar dit lukt niet.
Probeer de rest van de code te posten maar dit lukt me ook niet (eerder gemeld dat ik moeilijkheden heb om te posten)

Zal vanavond de code doorsturen.
Uw code werkt niet bij mij omdat de werkboek een naam wordt gegeven, in een andere sub heb ik een werkboek aangemaakt met de bedoeling deze te elke dag te mailen en dus niet gesaved wordt.

Grtjs,
Amber
 
Laatst bewerkt:
Dit is dan eindelijk de code die ik tot hiertoe heb:
Sorry voor de last maar ik ben blij dat jullie mij helpen:thumb:
Ik voeg nog even een realistischer excel voorbeeld toe Bekijk bijlage Book1.xls

Code: 
Dim xlApp As Excel.Application, xlBook As Excel.Workbook, xlSheet As Excel.Worksheet, Range As Excel.Range Dim xlWorkSheetF As Excel.WorksheetFunction, xlRange As Excel.Range

Public Sub leesrapport()
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    Set xlWorkSheetF = xlApp.WorksheetFunction
    Set xlRange = xlSheet.Range("A1")
    
    With xlSheet
        .Application.Visible = True
        .Select
    End With

        
    Dim varData, i As Variant
    varData = fPick_Rep(Me)
        
        For Each i In varData
            xlRange.Resize(UBound(varData) + 1, 1) = xlWorkSheetF.Transpose(varData)
        Next i
       
    Call DeleteEmptyRows

    Set xlApp = Nothing
End Sub

Code: 
Public Sub DeleteEmptyRows()
Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks Set xlSheet = xlBook.Worksheets(1) Set xlWorkSheetF = xlApp.WorksheetFunction Set xlRange = xlSheet.Range("A1")

Dim C As Range
    
    With xlSheet.Columns(1)
        Set C = .Find(What:=Left("Products", 8), _
                After:=Cells(1, 1), _
                LookAt:=xlPart, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=True)
        If Not C Is Nothing Then
            If C.Row > 1 Then
                Cells.Resize(C.Row - 1).EntireRow.Delete
            End If
        End If
    End With
End Sub

Groetjes,
Amber
 
Als ik het goed begrijp roep je Excel op vanuit een ander programma, anders heeft "set xlApp" etc niet zoveel zin.

Als je beide macro's in dezelfde module zet dan zou het moeten werken.
Dim xlApp As Excel.Application, xlBook As Excel.Workbook, xlsheet As Excel.Worksheet, Range As Excel.Range
Dim xlWorkSheetF As Excel.WorksheetFunction, xlRange As Excel.Range

Public Sub leesrapport()
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlsheet = xlBook.Worksheets(1)
Set xlWorkSheetF = xlApp.WorksheetFunction
Set xlRange = xlsheet.Range("A1")

With xlsheet
.Application.Visible = True
.Select
End With


Dim varData, i As Variant
varData = fPick_Rep(Me)

For Each i In varData
xlRange.Resize(UBound(varData) + 1, 1) = xlWorkSheetF.Transpose(varData)
Next i

DeleteEmptyRows xlsheet
Set xlApp = Nothing
End Sub

Public Sub DeleteEmptyRows(xlsheet)
Dim C As Range

With xlsheet.Columns(1)
Set C = .Find(What:="Products", _
After:=.Cells(1, 1), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not C Is Nothing Then
If C.Row > 1 Then
.Cells(1, 1).Resize(C.Row - 1).EntireRow.Delete
End If
End If

End With
End Sub
Klik om te vergroten...
 
Hoi Emil,

Geweeeeeeeeeeeeeeeeeeldig, het lukt nu perfect :love:
Effe kijken of ik snap wat er gebeurt: If C.Row > 1 Then (doe je dit omdat het cijfer 1 kleiner is dan een letter?

Bedankt aan iedereen die me hierbij geholpen heeft.

Jammer genoeg is de lay-out in een excel werkboek een ramp en ga ik proberen dit met word te doen (zal een ander draadje aanmaken)

Thanks Guys,
Ambertje
 
de variabele C bevat een celverwijzing naar de cel waarin "Products" staat.

terecht merkte Mark op dat het verwijderen van regels niet nodig is als C verwijst naar A1.
dus moet het rijnummer van C > 1 zijn. (c.row > 1)

duidelijk?
 
De data die jij binnenkrijgt is een soort derderangs fixed width data bestand, daar zul je met word ook niet veel wijzer van worden.

Je kunt in Excel met de optie tekst naar kolommen de data over meerdere kolommen verspreiden, en dat lukt me nog wel, maar het de mindere kant van het verhaal is dat de "afzender" allerlei informatie met andere indeling in een plat tekstbestand verstuurd.
met andere woorden: je moet er een studie aan wijden om deze data goed te formatteren, of het bericht te laten segmenteren, zodat je een vast dataformat hebt per ontvangen informatie.

Ik zag trouwens ook dat emil gelijk had betreffende de lengte van de regel met het woord products, Ik heb heel book3.xls niet gezien, omdat de informatie verdeeld was over 3 posts. Dus Emil, je had inderdaad gelijk ;).

Als je in excel de volgende macro plakt, kun je een voorbeeld krijgen van wat je kunt doen met tekst naar kolommen.

Dit voorbeeld is gemaakt op basis van de data van Book1.xls uit post #11.

Succes met je onderneming in ieder geval.

Code: 
Option Explicit

Sub Opmaken()

    If Left(Range("a1"), 8) = "Products" Then
    
        With Range("a1").End(xlDown).End(xlDown).CurrentRegion

            .Resize(.Rows.Count - 1).TextToColumns _
                        Destination:=Range(.Address), DataType:=xlFixedWidth, _
                        FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(11, 1), _
                                    Array(16, 1), Array(22, 1), Array(31, 1), _
                                    Array(37, 1), Array(43, 1), Array(49, 1), _
                                    Array(58, 1), Array(65, 1), Array(72, 1), _
                                    Array(80, 1), Array(89, 1), Array(96, 1), _
                                    Array(104, 1), Array(112, 1), Array(118, 1), _
                                    Array(124, 1)), _
                        TrailingMinusNumbers:=True
        
        End With
    
    Else
    
        MsgBox "haal eerst de lege rijen weg"
    
    End If
        
End Sub
 
Laatst bewerkt:
Emil,

De 1ste keer lukte het perfect maar als ik nu opnieuw probeer komt er een Error tevoorschijn: method cells of object _global failed net voor If Not C Is Nothing Then.

De fout treedt op bij de verwijzing naar de Cell, ik snap het niet goed want ik heb toch verwezen naar xlSheet met With ?

Zie jij waar ik nog iets moet aanpassen?:confused:

Grtjs,
Amber
 
Jongens het is opgelost, ik heb voor het objectje Cells nu xlSheet.Cells gezet en na herhaalde pogingen blijft het werken.

Mark ik ga jouw code met de Array's zeker uittesten ;-)

Groetjes,
Amber
 
Mark xl zei:
De data die jij binnenkrijgt is een soort derderangs fixed width data bestand, daar zul je met word ook niet veel wijzer van worden.

Je kunt in Excel met de optie tekst naar kolommen de data over meerdere kolommen verspreiden, en dat lukt me nog wel, maar het de mindere kant van het verhaal is dat de "afzender" allerlei informatie met andere indeling in een plat tekstbestand verstuurd.
met andere woorden: je moet er een studie aan wijden om deze data goed te formatteren, of het bericht te laten segmenteren, zodat je een vast dataformat hebt per ontvangen informatie.

Ik zag trouwens ook dat emil gelijk had betreffende de lengte van de regel met het woord products, Ik heb heel book3.xls niet gezien, omdat de informatie verdeeld was over 3 posts. Dus Emil, je had inderdaad gelijk ;).

Als je in excel de volgende macro plakt, kun je een voorbeeld krijgen van wat je kunt doen met tekst naar kolommen.

Dit voorbeeld is gemaakt op basis van de data van Book1.xls uit post #11.

Succes met je onderneming in ieder geval.

Code: 
Option Explicit

Sub Opmaken()

    If Left(Range("a1"), 8) = "Products" Then
    
        With Range("a1").End(xlDown).End(xlDown).CurrentRegion

            .Resize(.Rows.Count - 1).TextToColumns _
                        Destination:=Range(.Address), DataType:=xlFixedWidth, _
                        FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(11, 1), _
                                    Array(16, 1), Array(22, 1), Array(31, 1), _
                                    Array(37, 1), Array(43, 1), Array(49, 1), _
                                    Array(58, 1), Array(65, 1), Array(72, 1), _
                                    Array(80, 1), Array(89, 1), Array(96, 1), _
                                    Array(104, 1), Array(112, 1), Array(118, 1), _
                                    Array(124, 1)), _
                        TrailingMinusNumbers:=True
        
        End With
    
    Else
    
        MsgBox "haal eerst de lege rijen weg"
    
    End If
        
End Sub
Klik om te vergroten...
 
Mark xl

Ik heb jouw voorbeeld uitgeprobeerd om tekst naar kolommen om te zetten en dit lukt heel mooi (snap zelfs hoe het gebeurd ;-) ) maar ik heb nog een vraagje over deze code:

Het Excel voorbeeld dat je hebt gezien was maar 1 blz. lang terwijl die bladzijde (volledig van "Products") soms meerdere malen herhaald wordt.
Ik heb dan uw Macro laten lopen en enkel de 1ste blz.wordt naar kolommen omgezet, de andere blz.niet.

Weet je hier ook een oplossing voor aub?

Ik stuur nog even een voorbeeldje mee.
Bekijk bijlage Book3.xls

Groetjes,
Ambertje
 
Hoi Ambertje,

bij mij werkte het met onderstaande code
Hopelijk bij jou ook :)

Code: 
Option Explicit

Sub Opmaken()
Dim lngRow As Long
Dim rngSplit As Range

    If Left(Range("A1"), 8) = "Products" Then

        Set rngSplit = Columns("A").Find("Products", _
                                         lookat:=xlPart, _
                                         LookIn:=xlValues, _
                                         MatchCase:=False)
    
        If Not rngSplit Is Nothing Then
            
            Do
            
                lngRow = rngSplit.Row
                With rngSplit.End(xlDown).CurrentRegion
                
                   .Resize(.Rows.Count - 1, 1).TextToColumns _
                        Destination:=Range(.Address), DataType:=xlFixedWidth, _
                        FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(11, 1), _
                                        Array(16, 1), Array(22, 1), Array(31, 1), _
                                        Array(37, 1), Array(43, 1), Array(49, 1), _
                                        Array(58, 1), Array(65, 1), Array(72, 1), _
                                        Array(80, 1), Array(89, 1), Array(96, 1), _
                                        Array(104, 1), Array(112, 1), Array(118, 1), _
                                        Array(124, 1)), _
                        TrailingMinusNumbers:=True
                End With
                
                Set rngSplit = Columns("A").Find("Products", _
                                     after:=rngSplit, _
                                     lookat:=xlPart, _
                                     LookIn:=xlValues, _
                                     MatchCase:=False).End(xlDown)
                        
            Loop Until rngSplit.Row <= lngRow
        
        Else
        
            MsgBox "geen data gevonden!"
        
        End If
    
    Else
    
        MsgBox "haal eerst de lege rijen weg"
    
    End If
        
End Sub

Succes ermee!
Mark.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan