Excel Database

Status
Niet open voor verdere reacties.
T

Tsw

Gebruiker
Lid geworden
5 dec 2011
Berichten
183
Hallo,

Zie mijn voorbeeld bestand.

In mijn bedrijf scannen we bepaalde artikelen per werknummer.
deze scanners lezen wij uit en komt in een excel bestand te staan. (blad 1)
In cel "A2" komt het werknummer te staan.
In kolom B2 tot B200 komen de artikelen + vaknummers te staan.

Nu wil ik op blad 2 een database hier voor aanleggen.
In kolom A moet hij het werknummer neer zetten, en daarachter alle artikelen incl. vakken.
Als het werknummer van A2 al bestaat in de kolom A op blad 2 moet hij het achter het bestaande werknummer plakken. (dus alleen de artikelen achter de bestaande artikelen.)

En als het werknummer nog niet voorkomt op blad 2 moet hij een nieuwe regel aanmaken met vooraan het werknummer en daarachter de artikelnummers.

Is dit mogelijk?


Bekijk bijlage Voorbeeld blad.xlsx
 
Geen Probleem.

Wat heb je zelf zoal gedaan ? Want een totaaloplossing wil je natuurlijk niet, omdat je daar niets van leert.
 
Dit is natuurlijk een voorbeeld bestand, in mijn 'hoofd' bestand staan bedrijfsgegevens.

Maar ik heb op dit moment zo iets als wat nu in de bijlage zit. Ik heb een macro gemaakt die het kopieert naar het andere tabblad.
Voor elk werknummer een nieuwe rij aanmaken is geen probleem.

Echter als het werknummer al voorkomt in de rij, moeten de artikelen er achter komen te staan, en ik heb geen flauw idee hoe dat moet.
Ik denk iets met VERT.ZOEKEN, alleen weet niet hoe dat met VBA gaat.

Bekijk bijlage Voorbeeld blad.xlsx
 
snb,

Code: 
    Sheets("Blad2").Select
    Range("A2").Select
    Cells.Find(What:=Sheets("Blad1").Range("A2"), After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Selection.End(xlToRight).Offset(0, 1).Select

Zoiets? Alleen als hij dan niets vind moet hij het werknummer niet vind, moet hij een nieuwe regel aanmaken.
 
Code: 
Sub VenA()
  Dim f As Range, ar
  ar = Sheets("Blad1").Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
  With Sheets("Blad2")
    Set f = .Columns(1).Find(Sheets("Blad1").Range("A2"), , xlValues, xlWhole)
    If Not f Is Nothing Then
      f.End(xlToRight).Offset(, 1).Resize(, UBound(ar)) = Application.Transpose(ar)
     Else
      With .Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .Value = Sheets("Blad1").Range("A2").Value
        .Offset(, 1).Resize(, UBound(ar)) = Application.Transpose(ar)
      End With
    End If
  End With
End Sub
 
Code: 
ar = Sheets("Blad1").Range("B2:B" & [COLOR=#ff0000]Sheets("Blad1")[/COLOR].Cells(Rows.Count, 2).End(xlUp).Row)

Als in kolom A met find de tekst wordt gevonden, en er in kolom B niets staat gaat dit.....
Code: 
f.End(xlToRight).offset(,1)
....natuurlijk in de fout (kolom XFD) in Excel 2007 en hoger (.offset(,1) is er niet).


Zo kan je wel een tijdje vooruit.
Code: 
[COLOR=#ff0000].cells(f.row,columns.count).end(xltoleft)[/COLOR].Offset(, 1).Resize(, UBound(ar)) = Application.Transpose(ar)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan