Check alle échte Black Friday-deals Ook zo moe van nepaanbiedingen? Wij laten alleen échte deals zien
Toon posts:

[Excel][Macro's] bereik bepalen op basis van inhoud cel

Pagina: 1
Acties:

Verwijderd

Topicstarter
Is het mogelijk om een range te bepalen aan de hand van inhoud van cellen?
Ik heb in een document een aantal blokken met bestellingen onder elkaar staan.

Elk blok begint met een cel dat als inhoud de tekst "Bestelling" heeft, en eindigt twee cellen verder naar rechts van een cel met de inhoud "Aantal colli:"
Ik wil deze blokken dus via een Macro detecteren, en voorzien van een dikke rand.

De reden waarom ik dit wil automatiseren, is dat er dagelijks een .csv bestand geïmporteerd wordt met een lijst van bestellingen, en deze moeten met een druk op de knop voorzien worden van een rand om de print overzichtelijker te maken.

Elke bestelling is gescheiden door een dubbele witregel.

Ik kan hier geen bestand toevoegen, maar de .csv is als volgt ingedeeld:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Bestelnummer,"Besteldatum","Klant","Verzendadres","Factuuradres",""
00049,"20-01-10","Administrator (admin)","Bez - Piet Heinstraat 19A, Bez - 7511 JE  Bez - Enschede","Piet Heinstraat 19 A, 7511 JE Enschede",""
"","","","","",""
"Bestelde artikelen","EAN code","Product","Inhoud per verpakking","Aantal colli","Aantal gepickt"
"AA123","XXXXXXXXXXXXX","Canisius, Peren-appel-cranberrystroop in glazen pot. 300 gram","6 st","10",""
"","","Canisius, 4 vruchtenstroop in glazen pot. 300 gram","6 st","10",""
"","","","","",""
"","","","Totaal Colli:","antwoord som colli"
"","","","","",""
"","","","","",""
Bestelnummer,"Besteldatum","Klant","Verzendadres","Factuuradres",""
00049,"20-01-10","Administrator (admin)","Bez - Piet Heinstraat 19A, Bez - 7511 JE  Bez - Enschede","Piet Heinstraat 19 A, 7511 JE Enschede",""
"","","","","",""
"Bestelde artikelen","EAN code","Product","Inhoud per verpakking","Aantal colli","Aantal gepickt"
"AA123","XXXXXXXXXXXXX","Canisius, Peren-appel-cranberrystroop in glazen pot. 300 gram","6 st","10",""
"","","Canisius, 4 vruchtenstroop in glazen pot. 300 gram","6 st","10",""
"","","","","",""
"","","","Totaal Colli:","antwoord som colli"
"","","","","",""
"","","","","",""



In bovenstaand voorbeeld zijn twee bestellingen genoemd, hoe zorg ik er nou voor dat de Macro beide blokken herkent en voorziet van een dik kader?
Als ik dit weet, kan ik de rest van de opmaak ook automatiseren.

Alle hulp is welkom!

  • MrAngry
  • Registratie: December 2001
  • Laatst online: 23:05
Is het niet zo dat elk blok gewoon bestaat uit 6 of 7 kolommen en 8 rijen? Want dan laat je hem toch gewoon tekenen om een range(Bestelnummer+6kolommen,8 rijen). Of verschilt het weleens met je voorbeeld csv

Er is maar één goed systeem en dat is een geluidsysteem - Sef


  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

Inderdaad, staan Aantal colli en Bestelling niet altijd in dezelfde 'kolom'? Dan is het toch heel simpel steeds (i,j) t/m (i,k) markeren.

Als variabel, kort antwoord: ja, dat kan. Maak een loopje: ga naar regel i, zoek op die regel naar "Bestelling" en onthoud in een variabele j het kolomnummer, zoek op die regel naar "Aantal colli" en onthoud het in variabele k. Dan (i,j) t/m (i,k) markeren.

Even heel erg kort door de bocht:
Visual Basic:
1
2
3
4
5
6
Option Explicit
Sub foo()
    Dim i, j As Integer
    i = 2
    j = Cells.Find(What:="vla", After:=Cells(i, 1), LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
End Sub

(Natuurlijk aanpassen naar wens: loop, zorgen dat je op regel i blijft, opmaak er omheen zetten).

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


Verwijderd

Topicstarter
Bedankt voor de snelle antwoorden :)

@MrAngry:
De velden die de tekst "Aantal colli" en "Bestellingen" bevatten staan inderdaad altijd in dezelfde kolom.
Hierdoor had ik de methode die je beschrijft al eerder afgestreept.

Het is de bedoeling om het volgende effect te bereiken:
http://i49.tinypic.com/r9rhhs.png

Wat ik dus zou willen is de volgende stappen (ik ben helaas niet thuis in VBA, vandaar dat ik het uitschrijf.)
- Zoek eerstvolgende cel met inhoud "Bestellen"
- Sla de locatie op in de eerste variabele (LocA)
- Zoek de eerstvolgende cel met inhoud "Aantal colli"
- Selecteer de cel twee kolommen naar rechts
- Sla de locatie van deze cel op in de tweede variabele (LocB)
- Selecteer bereik (LocA; LocB)
- Pas opmaak toe (dikke rand)

De meeste instructies kan ik via de recorder verkrijgen, maar ik weet niet hoe ik variabelen kan definiëren en de locatie van de twee gevonden cellen daarin opslaan en gebruiken om een bereik te selecteren.
Als ik dit voor mekaar krijg ben ik gered.

Edit: @F_J_K:
Het kan zijn dat je met jouw antwoord de oplossing gaf voor mijn vraagstuk, maar kun je dat misschien iets minder kort door de bocht uitwerken?
Ik weet zo niet hoe ik dit moet gaan inpassen. Ga voor het gemak maar even er vanuit dat ik een complete n00b ben met VBA (Wat ook zo is :X )

Ik heb nu het volgende (gedeelte van opmaak van de randen weggelaten):
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Macro5()
' Macro5 Macro
Dim i, j As Integer
i = Cells.Find(What:="Bestelnummer", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
j = Cells.Find(What:="Totaal Colli:", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    
    Range(i, j).Select
    Range(i).Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    ....
End Sub


Maar ik krijg uiteraard een error bij de Range. En de variabele j moet nog twee plaatsen naar rechts.

Alvast excuses voor de onkunde :P

[ Voor 38% gewijzigd door Verwijderd op 21-01-2010 12:41 ]


  • MrAngry
  • Registratie: December 2001
  • Laatst online: 23:05
Verwijderd schreef op donderdag 21 januari 2010 @ 12:25:
Bedankt voor de snelle antwoorden :)

@MrAngry:
De velden die de tekst "Aantal colli" en "Bestellingen" bevatten staan inderdaad altijd in dezelfde kolom.
Hierdoor had ik de methode die je beschrijft al eerder afgestreept.

Het is de bedoeling om het volgende effect te bereiken:
http://i49.tinypic.com/r9rhhs.png

Wat ik dus zou willen is de volgende stappen (ik ben helaas niet thuis in VBA, vandaar dat ik het uitschrijf.)
- Zoek eerstvolgende cel met inhoud "Bestellen"
- Sla de locatie op in de eerste variabele (LocA)
- Zoek de eerstvolgende cel met inhoud "Aantal colli"
- Selecteer de cel twee kolommen naar rechts
- Sla de locatie van deze cel op in de tweede variabele (LocB)
- Selecteer bereik (LocA; LocB)
- Pas opmaak toe (dikke rand)

De meeste instructies kan ik via de recorder verkrijgen, maar ik weet niet hoe ik variabelen kan definiëren en de locatie van de twee gevonden cellen daarin opslaan en gebruiken om een bereik te selecteren.
Als ik dit voor mekaar krijg ben ik gered.
Omdat je weet dat de data altijd begint in Kolom B en eindigt in Kolom F heb je om een range te selecteren voor opmaak nog alleen nog maar de variabele regelnummers nodig. Die kennis moet je even toepassen op je macro. Ik zal hieronder ook even proberen uit te leggen wat er in de macro gebeurt
Ik heb nu het volgende (gedeelte van opmaak van de randen weggelaten):
code:
1
2
3
Sub Macro5()
' Macro5 Macro
Dim i, j As Integer
Je (of eigenlijk FJK) definieerd hier variabelen i en j als integer (als getal)
code:
1
2
3
4
5
6
i = Cells.Find(What:="Bestelnummer", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
j = Cells.Find(What:="Totaal Colli:", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
Hier wil je i en j invullen. Denk eraan dat het enige wat we nog nodig hebben de regelnummers van de gevonden cellen zijn. Wat je nu doet is de gevonden cellen activeren, waarvan de output geen integer is, waardoor er niks gebeurt. Wat we willen zijn de regelnummer. Vervang .activate door .row
code:
1
    Range(i, j).Select
Hier krijg je nu een error omdat i en j leeg zijn, maar de syntax is sowieso niet goed. Je kan op deze manier een range selecteren als i en j anders gedefinieerd zijn. We doen het, omdat het regelnummers zijn, nu zo:
Range("B"&i,"F"&j).select
code:
1
    Range(i).Activate
Dit is fout en moet weg.
code:
1
2
3
4
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    ....
End Sub


Maar ik krijg uiteraard een error bij de Range. En de variabele j moet nog twee plaatsen naar rechts.

Alvast excuses voor de onkunde :P
Uiteraard kan het allemaal nog veel netter en sneller (.select kan/wil je over het algemeen vermijden), maar dit zal even voldoen, als je je erin verdiept kom je wel verder.

Er is maar één goed systeem en dat is een geluidsysteem - Sef


Verwijderd

Topicstarter
Super, hier kan ik weer mee aan de slag!

Verwijderd

Topicstarter
Update :D
In twee delen nog wel, maar dat zal wel eleganter op te lossen zijn.

Allereerst word de import van het CSV bestand met een macro afgehandeld om de verwerking correct te doen en op de juiste plaats te dumpen.

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub Import_CSV()
'
' Import_CSV Macro
'
' Sneltoets: CTRL+i
'
        With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Documents and Settings\doubledeal\Bureaublad\Kopie van report.all.csv" _
        , Destination:=Range("$B$2"))
        .Name = "Kopie van report.all_2"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A1").Select
    Application.Run "'Kopie van report.all.xlt'!Opmaak_Picklijst"
End Sub


Zoals je ziet wordt aan het eind de Macro opgestart voor de opmaak van de zojuist geïmporteerde gegevens.
Deze tussenoplossing is puur en alleen vanwege het feit dat er per run maar één blok opgemaakt wordt. Dit omdat ik nog niet weet hoe ik een loopje maak waarin de hele lijst wordt behandeld.
Ik geloof dat ik hiervoor de volgende stappen nodig heb:
- óf detecteren hoe vaak het veld "Bestelling" voorkomt en opslaan in een variabele, óf weten wat de laatste regel is waarin gegevens voorkomen en opslaan in een variabele.
- Variabelen definiëren voor de teller en de eindwaarde
- De code voor de opmaak in een While lus zetten. While Count < End; Count = Count +1

Wat denken jullie?

De opmaak wordt als volgt gedaan:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub Opmaak_Picklijst()
'
Dim i, j As Integer

i = Cells.Find(What:="Bestelnummer", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row
j = Cells.Find(What:="Totaal Colli:", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row


    
    Range("B" & i, "G" & j).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("G" & j).Select
End Sub



Als ik (we/jullie) het voor mekaar krijg(en) om automatisch alle blokken van de opmaak te voorzien met een loopje kan alles uiteraard in één Macro gedaan worden.
Nu is het importeren met Ctrl+i, en dan net zo lang opmaak toevoegen met Ctrl+l tot alle blokken zijn gedaan en hij weer bij B2 uitkomt.

Misschien is dat het antwoord wel: als i=2, dan End Macro, ofzoiets.
Oh nee, dan stopt ie al bij de eerste run.

Hersengymnastiek en ik gaan op dit moment niet samen :(

Verwijderd

Topicstarter
Ik heb het in elk geval werkend. Waarschijnlijk enorm on-geoptimaliseerd, maar vooruit.

Eerst de variabelen gedefinieerd:
Dim i, j, LastRow As Integer

Dan de laatste rij bepalen en opslaan:
LastRow = ActiveSheet.UsedRange.Rows.Count

Beginnen vanaf A1:
Range("A1").Select

En dan de lus met het selecteren en opmaken van een blok zoals in de vorige post:
Do
blabla
Loop Until j > LastRow

Waarschijnlijk kan er nog aardig wat aan geschaafd worden om de boel wat vlotter te laten verlopen, maar ik kan in elk geval iemand blij maken.

  • Dommel
  • Registratie: Maart 2001
  • Laatst online: 12-11 16:53

Dommel

Professioneel Software Sloper

Eerst de variabelen gedefinieerd:
Dim i, j, LastRow As Integer
Misschien dat je het inmiddels al wel weet maar mocht je het niet weten, je hebt hier alleen LastRow als integer gedefinieerd. i en j zijn nu van het type Variant. Wil je die ook expliciet als integer hebben dan kun je of elke variable apart op een regel (optie 1) zetten of alles toch op dezelfde regel laten staan (optie 2):
Optie1:
Dim i As Integer
Dim j As Integer
Dim LastRow As Integer

Optie 2:
Dim i As Integer, j As Integer, LastRow As Integer
Het kan bij debuggen wel eens handig zijn om te weten welk type je variable nu precies zijn.

Lego Taj Mahal te koop --> https://gathering.tweakers.net/forum/list_messages/2109838


Verwijderd

Topicstarter
Ah, dat wist ik inderdaad niet. Ik was er vanuit gegaan dat de methode hetzelfde zou zijn als met Java.
Bedankt.

Het project is nu afgerond, waarvoor dank!
Pagina: 1