onder elkaar plaatsen : controle lijst

grema · 10 feb 2007

ik zoek een reeks van 4 kolommen (die nu naast elkaar staan)
per groep van 4 onder elkaar te plaatsen.

maw : art1 aantal 1 lev 1 besteldata1
art 2 aantal 2 lev 2 besteldata1

een voorbeeld in bijlage is duidelijker .

het probleem is echter dat deze kolom steeds worden vernieuwd en langer kunnen worden naargelang er in bestelling is ; Dus cel verwijzing lukt niet .

wat kan dan wel

met dank bij voorbaat
aan allen die hun kennis weer even willen delen

grema

Withaar · 11 feb 2007

Ik snap er helemaal niets van...

Code:

ik zoek een reeks van 4 kolommen (die nu naast elkaar staan)

Je zoekt iets dat er al staat... bedoel je dat je iets wilt met vertikaal zoeken of zo?

Code:

per groep van 4 onder elkaar te plaatsen.

Wil je de 4 groepen (ik neem aan A-D, E-H, I-L en M onder elkaar hebben?
Extra kolom toevoegen lijkt me, hernoem de Artikel 1,2,3, 4 gewoon om naar Artikel en zet in de extra kolom de artikel 'code'
Zo iets bijvoorbeeld;

Toevoegen is geen probleem (op de eerste lege regel) en na het toevoegen gewoon even op Artikel en dan op Artikel code sorteren en alles staat weer netjes bij elkaar.

grema · 11 feb 2007

Withaar

aangezien het een lijst is afkomstig van een bestelprogramma ; dacht ik naar leverancier toe de artikels onder elkaar te plaatsen om duidelijk een lijst te verkrijgen om door te kunnen faxen .

dus : resultaat

zie bijlage

Withaar · 11 feb 2007

Zijn het altijd vier kolommen x 4 kolommen?
Waar wil je de nieuwe tabel hebben staan, er onder, nieuw tabblad?
Wil je uitleg over hoe je dan handmatig kan doen of een macro?

Vreemd bestel programma oveigens dat, een dergelijke output geeft, waarom niet direct in een lijstje.
Is het in excel of een ander programma gemaakt?

grema · 11 feb 2007

withaar,

het is inderdaad gemaakt in excell.

de resultaten komen van een bestelprogramma opgesteld door collega " Ferenc"
gebaseerd op 4 artikels . Daar ik niet voldoende ken van VBASIC heb ik de lijsten uitgebreid naar 15 artikels wat voldoende is.

De manier waarop is uiteindelijk misschien veel te complex geworden , maar hij doet het .
Initieel kreeg ik de 4 artikels mooi op een lijn , wat nog duidelijk was .
Met mijn uitbreiding is het complex geworden , vandaar sorteren onder elkaar op een nieuw " tabblad" .

!!! moet voor de duidelijk meegeven dat dit zonder hulp van Ferenc en n Wigi niet tot stand was gekomen ) Waarvoor ik hem en ook dank .

ps : kan je even aangeven hoe ik mijn bijlage bestand kan leegmaken ; zodanig dat ik de laatste versie even kan meesturen ??

Withaar · 11 feb 2007

bijlage bestand kan leegmaken

Ik heb even wat oude vragen door gekeken. ik denk dat ik weet over wel programma je het hebt maar zou inderdaad graag de laaste versie daarvan zien.
Zo te zien is er een tabblad Bestel_lijst en Bestel_lijst2.
Selecteer gewoon regels 7 t/m de laatste gevulde regel, rechter muisknop en dan kiesen voor verwijderen. Doe dat met beide tabbladen.
Sla deze versie op (andere naam...) en als je XP hebt kun je in de verkenner de optie 'Kopieeren naar..' 'Gecomprimeerde map' gebruiken anders moet je even een andere zip programma gebruiken zoals 7zip.

N.b. maak altijd eerst even een copy en ga daarmee aan de slag....

grema · 12 feb 2007

m ' n laatste versie . blijft hangen op 156 Kb ( gestripte versie)

Kan de moderator toelaten dat ik ze op een andere manier verzend en deze dan voor iedereen toegankelijk maken

met dank

grema

Demeter · 12 feb 2007

Grema,

Post eens een voorbeeld van alleen het overzihctblad? Welke kolommen worden er gebruikt voor artikel 1, artikel, etc.....
Denk dat we door deze data moeten gaan lopen met een loop oid (Als art.nr niet leeg is dan kopieer naar).

Heb nog een vraag voor je:
Komen alle artiekeln van dezelfde leverancier of zijn er meerdere?
dit zodat we weten welke artikelen we moeten gaan kopieeren.

Misschien is het wel handig om ze zoiezo op een blad onderelkaar te gaan zetten zodat je met een filter makkelijk alles op datum/leverancier of levertijden kan zoeken.
we horen het wel.

Groet,
Ferenc

grema · 12 feb 2007

Ferenc ,

tof dat je weer even inhaakt .:thumb:

in bijlage : het overzicht van de bestelinfo fiche in word-document.
de bestellijst ( die je maakte tot 4 lijnen -- nu uitgebreid naar 15 lijnen )

De kleur in de vakken geeft aan dat deze artikelds nog neit werden beseld ( via voorwaardelijke opmaak ingegeven )

De lijst dient effectief om te sorteren naar meerdere leveranciers .
Maar kan eventueel via knippen en plakken (iets complexer ook gescheiden worden )
Sorteren per lev zou toch nog beter zijn . Geef daarbij dan voorkeur aan sorteren tot
3 leveranciers ( 2 hoofdleverancier zijnde lev " X " en " Y " en 1 leverancierlijst voor al de andere die weinig of zelden worden gebruikt ( deze goederen zouden dan op 1 lijst mogen komen te staan )

Wigi gaf ook reeds aan dat ik een loop moest gebruiken , maar ben daar nog lang niet uit .

alvast dank aan allen die hulp en steun verlenen .

Demeter · 12 feb 2007

Doe het niet graag maar een incomplete code (heb vanavond weinig tijd en orgen erg vroeg op

)

Code:

Dim d As Range
Dim laatsteregel As Long
Dim legeregel As Long
Dim kolom As Variant
Dim pl2 As Integer

For Each c In Sheets("Blad1").Range("A1:BH1")
    If Mid(c.Value, 1, 7) = "Artikel" Then
    
        pl2 = InStr(InStr(c.Address, "$") + 1, Right(c.Address, Len(c.Address) - InStr(c.Address, "$")), "$")
        kolom = Mid(c.Address, InStr(c.Address, "$") + 1, pl2 - 1)
        laatsteregel = Sheets("Blad2").Range(kolom & "65536").End(xlUp).Row + 2
        
        For Each d In Sheets("Blad1").Range(kolom & "2:" & kolom & laatsteregel)
            If d.Value <> "" Then
                If [COLOR="red"]Range(kolom & d.Row).Interior.ColorIndex = 33[/COLOR] Then
                    legeregel = Sheets("Blad2").Range("A65536").End(xlUp).Row + 1
                    d.Resize(, 4).Copy Sheets("Blad2").Range("A" & legeregel)
                ElseIf [COLOR="Red"]Range(kolom & d.Row).Interior.ColorIndex = 0 [/COLOR]Then
                    legeregel = Sheets("Blad3").Range("A65536").End(xlUp).Row + 1
                    d.Resize(, 4).Copy Sheets("Blad2").Range("A" & legeregel)
                End If
            End If
        Next
    End If
Next

End Sub

Rode gedeelten krijg ik nog niet aan de gang, hierin moet hij controleren of de achtergrond kleur voldoet voor leverancier 1 of 2 (uit te breiden naar meer). Nu geeft hij een rare responds. Komt morgen wel goed, maar misschien kan je er zelf uitkomen of dat een ander er naar kan kijken.

Hier een werkende code zonder dat we de leveranciers scheiden.
Hoor graag wat je er van vindt.

Code:

Sub overzetten_lijst()
Dim c As Range
Dim d As Range
Dim laatsteregel As Long
Dim legeregel As Long
Dim kolom As Variant
Dim pl2 As Integer

For Each c In Sheets("Blad1").Range("A1:BH1")
    If Mid(c.Value, 1, 7) = "Artikel" Then
    
        pl2 = InStr(InStr(c.Address, "$") + 1, Right(c.Address, Len(c.Address) - InStr(c.Address, "$")), "$")
        kolom = Mid(c.Address, InStr(c.Address, "$") + 1, pl2 - 1)
        laatsteregel = Sheets("Blad2").Range(kolom & "65536").End(xlUp).Row + 2
        
        For Each d In Sheets("Blad1").Range(kolom & "2:" & kolom & laatsteregel)
            If d.Value <> "" Then
                    legeregel = Sheets("Blad2").Range("A65536").End(xlUp).Row + 1
                    d.Resize(, 4).Copy Sheets("Blad2").Range("A" & legeregel)
            End If
        Next
    End If
Next

End Sub

Volgens mij kan deze ook nog efficienter, maar daar kom ik later op terug.

Ik ga mijn bed in.
Succes!!!

Groet,
Ferenc

grema · 12 feb 2007

idem dito

kruip er ook in ,
bekijk het morgen weer verder

alvast bedankt

Demeter · 13 feb 2007

Grema,

Probeer deze versie eens, met verschillende data erin.

Edit: file aangepast, zat een foutje in de sheet verwijzing voor de laatsteregel.

Groet,
Ferenc

Demeter · 13 feb 2007

Code iets aangepast:

Code:

Sub overzetten_gegevens()
Dim d As Range
Dim laatsteregel As Long
Dim legeregel As Long
Dim kolom, leverancier1, leverancier2 As Variant
Dim pl2 As Integer

'Verander hier de namen van je leveranciers
leverancier1 = "ggg"
leverancier2 = "kevl"

'verander hier de namen van je tabbladen
'bij meerdr leveranciers wordt deze uitgebreid met tab4 = "naam tabblad 4"
tab1 = "Blad1"
tab2 = "Blad2"
tab3 = "Blad3"

For Each c In Sheets("Blad1").Range("A1:BH1")
    If Mid(c.Value, 1, 7) = "Artikel" Then
    
        pl2 = InStr(InStr(c.Address, "$") + 1, Right(c.Address, Len(c.Address) - InStr(c.Address, "$")), "$")
        kolom = Mid(c.Address, InStr(c.Address, "$") + 1, pl2 - 1)
        laatsteregel = Sheets(tab1).Range(kolom & "65536").End(xlUp).Row + 2
        
        For Each d In Sheets(tab1).Range(kolom & "2:" & kolom & laatsteregel)
            If d.Value <> "" And d.Offset(, 2) <> "" Then
                If d.Offset(, 2).Value = leverancier1 Then
                    legeregel = Sheets(tab2).Range("A65536").End(xlUp).Row + 1
                    d.Resize(, 2).Copy Sheets(tab2).Range("A" & legeregel)
                    d.Offset(, 3).Copy Sheets(tab2).Range("C" & legeregel)
                'om een extra leverencier bij te voegen kopieer onderste 4 regels
                'plak deze regeles onder de laatse van deze vier
                'verander alleen de tab3 naar tab4, geef boven bij je variabelen de naam voor tab4
                ElseIf d.Offset(, 2).Value = leverancier2 Then
                    legeregel = Sheets(tab3).Range("A65536").End(xlUp).Row + 1
                    d.Resize(, 2).Copy Sheets(tab3).Range("A" & legeregel)
                    d.Offset(, 3).Copy Sheets(tab3).Range("C" & legeregel)
                End If
            End If
        Next
    End If
Next

End Sub

Groet,
Ferenc

grema · 13 feb 2007

ferenc,

Bedankt voor het puzzelwerk en programma aanpassing
code doet het op opgegeven blad .:thumb:

Heb er een claer code aan toegevoegd ;

Code:

  'verander hier de namen van je tabbladen
tab1 = "Blad1"
tab2 = "Blad2"
tab3 = "Blad3"

[COLOR="Blue"]Blad2.Cells.ClearContents
Blad3.Cells.ClearContents[/COLOR]

Echter wanneer ik nu alles plak in mijn bestand lukt het niet

; vermoedelijk " tabbladen"

Heb nu : 7 BLADEN STAAN

Dus paste code als volgt aan :

Code:

'verander hier de namen van je tabbladen
tab5 = "Lev1"
tab6 = "Lev2"
tab7 = "Lev3"

For Each c In Sheets("bestellijst").Range("A1:BH1")
    If Mid(c.Value, 1, 7) = "Artikel" Then
    
        pl2 = InStr(InStr(c.Address, "$") + 1, Right(c.Address, Len(c.Address) - InStr(c.Address, "$")), "$")
        kolom = Mid(c.Address, InStr(c.Address, "$") + 1, pl2 - 1)
        laatsteregel = Sheets(tab4).Range(kolom & "65536").End(xlUp).Row + 2
    [COLOR="blue"]    ' hier gaat het fout  !!!!!![/COLOR]
        
        For Each d In Sheets(tab4).Range(kolom & "2:" & kolom & laatsteregel)
            If d.Value <> "" And d.Offset(, 2) <> "" Then
                If d.Offset(, 2).Value = leverancier1 Then
                    legeregel = Sheets(tab5).Range("A65536").End(xlUp).Row + 1
                    d.Resize(, 2).Copy Sheets(tab5).Range("A" & legeregel)
                    d.Offset(, 3).Copy Sheets(tab5).Range("C" & legeregel)
                ElseIf d.Offset(, 2).Value = leverancier2 Then
                    legeregel = Sheets(tab7).Range("A65536").End(xlUp).Row + 1
                    d.Resize(, 2).Copy Sheets(tab6).Range("A" & legeregel)
                    d.Offset(, 3).Copy Sheets(tab6).Range("C" & legeregel)
                End If
            End If
        Next
    End If
Next

End Sub

blad 1 = zoekn
blad 2 = bestel_lijst
blad 3 = bestel_lijst2
blad 4 = bestellijst ( totale lijst zoals ik in voorbeeld plaatste )
blad 5 = Lev1
blad 6 = Lev2
blad 7 = Lev3

Kan je de code even nakijken . Zit waarschijnlijk verkeerd met tabbladen , geeft aan dat tabblad 4 = leeg ???

Waar zit ik fout ???

Heb dus weer hulp nodig van een expert !!

grema · 13 feb 2007

annulatie hulp.

Ferenc,

terwijl ik de help - lijn weer opriep zag ik het .

heb in code volgende toegevoegd en het lukt :

Code:

 'verander hier de namen van je tabbladen
[COLOR="Blue"]tab4 = "bestellijst"[/COLOR]
tab5 = "Lev1"
tab6 = "Lev2"
tab7 = "Lev3"

sorry voor het te vroeg inroepen van de hulp. Maar toen de vraag weg was en ik ze even herbekeek viel men frank ( alle Euro )

Beter laat dan nooit.

groet grema

Puzzel weer even verder .

Thx.

grema · 13 feb 2007

nog even ( zeer belangrijk)
:thumb:
dank aan allen voor de reacties

grema

Demeter · 13 feb 2007

Graag gedaan, heb er zelf ook weer wat bij geleerd en jij zo te zien ook.
Daar gaat het toch om!

Groet,
Ferenc

grema · 13 feb 2007

kan het niet laten om elke avond toch nog iets uit te proberen (Loop regelmatig nog eens vast)
en even te kijken op het forum . ( ' heb het vermoeden dat jullie een virus

( een excell-vba virus mee gestuurd hebben . Zo eentje van : " probeer maar wat; maar laat ons nooit alleen ; anders blijft het forum niet bestaan ) waar ik niet meer van afgeraak.

Maar apprecieer al de hulp.

Tot binnenkort.

grema

onder elkaar plaatsen : controle lijst

grema

Gebruiker

Withaar

Verenigingslid

grema

Gebruiker

Withaar

Verenigingslid

grema

Gebruiker

Withaar

Verenigingslid

grema

Gebruiker

Demeter

Verenigingslid

grema

Gebruiker

Demeter

Verenigingslid

grema

Gebruiker

Demeter

Verenigingslid

Bijlagen

Demeter

Verenigingslid

grema

Gebruiker

grema

Gebruiker

grema

Gebruiker

Demeter

Verenigingslid

grema

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy