• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

listobject laten aansluiten aan vorig listobject

Status
Niet open voor verdere reacties.
M

moensk

Gebruiker
Lid geworden
23 jun 2013
Berichten
712
mijn ListObject(2) begint nu vast op rij 30.
Hoe kan ik dit variabel maken ?
deze zou moeten starten 2 rijen lager dan waar ListObject(1) eindigt.


Code: 
Sub registratie()
  Dim j As Long, t As Long, ar
  ar = Sheets("data").ListObjects(1).DataBodyRange
  With Sheets("controle")
    For j = 1 To UBound(ar)
      If ar(j, 1) = .Range("B1").Value And CStr(ar(j, 5)) = CStr(.Range("B2").Value) Then
        c00 = c00 & j & "|"
        t = t + 1
      End If
    Next j
    
    With .ListObjects(1)
      If .ListRows.Count Then .DataBodyRange.Delete
      If t > 0 Then
        .ListRows.Add.Range.Resize(t, 15) = Application.Transpose(Application.Index(ar, Split(c00, "|"), Application.Transpose(Array(60, 3, 8, 11, 15, 18, 59, 55, 56, 21, 32, 33, 31, 42, 43))))
        .Range.Sort .Range.Cells(1, 2), , .Range.Cells(1, 3), , , , , x1Yes
      End If
    End With
    .ListObjects(2).Range.Cut .Cells(30, 1)
  End With
End Sub


Sub boordcomputer()
    Set hoofding = Range(Cells(3, 1), Cells(3, 10))
    hoofding.Copy
    Range(Cells(30, 1), Cells(30, 10)).PasteSpecial xlPasteValues
  Dim j As Long, t As Long, ar
  ar = Sheets("boordcomputer").ListObjects(1).DataBodyRange
  With Sheets("controle")
    For j = 1 To UBound(ar)
      If ar(j, 1) = .Range("B1").Value And CStr(ar(j, 5)) = CStr(.Range("B2").Value) Then
        c00 = c00 & j & "|"
        t = t + 1
      End If
    Next j
    
    With .ListObjects(2)
      If .ListRows.Count Then .DataBodyRange.Delete
      If t > 0 Then
        .ListRows.Add.Range.Resize(t, 9) = Application.Transpose(Application.Index(ar, Split(c00, "|"), Application.Transpose(Array(20, 3, 8, 10, 11, 14, 19, 17, 18))))
        .Range.Sort .Range.Cells(1, 2), , .Range.Cells(1, 3), , , , , x1Yes
      End If
    End With
  End With
End Sub
 
Voldoet dit?
Code: 
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif].ListObjects(2).Range.Cut .Cells(t + 8, 1)[/FONT]
 
Of:
Code: 
Sub hsv()
Dim sq, s0 As String
  Sheets("data").ListObjects(1).DataBodyRange.Columns(1).Name = "br"
  With Sheets("controle")
    s0 = Join(Filter([transpose(if((br=controle!b1)*(offset(br,,4)=controle!B2),row(br),"~"))], "~", 0), "|") & "|"
     With .ListObjects(1)
      If .ListRows.Count Then .DataBodyRange.Delete
    If Len(s0) > 0 Then
       sq = Split(s0, "|")
.Parent.ListObjects(2).Range.Cut .Parent.ListObjects(1).Range.Cells(1).Offset(UBound(sq) [SIZE=5][COLOR=#ff0000]+ 2[/COLOR][/SIZE])
        .ListRows.Add.Range.Resize(UBound(sq), 14) = Application.Transpose(Application.Index(Sheets("data").ListObjects(1).Range, sq, Application.Transpose(Array(59, 3, 8, 11, 15, 18, 55, 56, 21, 32, 33, 31, 42, 43))))
        .Range.Sort .Range.Cells(1, 1), , .Range.Cells(1, 3), , , , , 1
   End If
    End With
  End With
End Sub
 
Laatst bewerkt:
Code: 
.ListObjects(2).Range.Cut .Cells(30, 1)

Komt ie stiekem weer op rij 30 te staan.;)
 
Uit Ts z'n vorige vraag aan het knippen plakken geweest, dan krijg je dat soms.
 
in bijlage zet ik even klein voorbeeld (heb aangepast naar cells(t+8, 1))
in voorbeeld heb ik 2 wagens waartussen gekozen kan worden 3105 & 1422
als ge een paar keer switcht tussen deze wagens + "ZOEK" aanklikken dan merkt ge dat
1. de tabel niet altijd gevormd wordt, als ge dan nog eens op zoek drukt wordt deze wel gevormd
2. na enkele keren dit uit te voeren wordt ListObject toch opgeslorpt komt er een foutmelding
 

Bijlagen

  • Pallet_Controle_test.xlsm
    63,1 KB · Weergaven: 10
Tja, mijn code heb je niet getest waarschijnlijk.
Het staat niet in het bestand wat je plaatste.

Ps. de code behoort in een standaard module (Menu invoegen → Module).
 
HSV ik had u code wel eens getest in het verleden doch ik kon ze niet lezen (te complex voor mij) vandaar was ik er niet mee verder was gegaan en de andere code werkte ook, vandaar ...
Heb ze nu terug toegepast en moet zeggen dat knop "ZOEK" goed werkt
Heb getracht script "Boordcomputer" aan te passen zodat dit ook zou werken, doch njet :)
kunt gij even kijken aub

Code: 
Sub registratie()
  Dim sq, s0 As String
  Sheets("data").ListObjects(1).DataBodyRange.Columns(1).Name = "br"
  With Sheets("controle")
    s0 = Join(Filter([transpose(if((br=controle!b1)*(offset(br,,4)=controle!B2),row(br),"~"))], "~", 0), "|") & "|"
     With .ListObjects(1)
      If .ListRows.Count Then .DataBodyRange.Delete
    If Len(s0) > 0 Then
       sq = Split(s0, "|")
        .Parent.ListObjects(2).Range.Cut .Parent.ListObjects(1).Range.Cells(1).Offset(UBound(sq) + 2)
        .ListRows.Add.Range.Resize(UBound(sq), 15) = Application.Transpose(Application.Index(Sheets("data").ListObjects(1).Range, sq, Application.Transpose(Array(60, 3, 8, 11, 15, 18, 59, 55, 56, 21, 32, 33, 31, 42, 43))))
        .Range.Sort .Range.Cells(1, 1), , .Range.Cells(1, 3), , , , , 1
   End If
    End With
  End With
End Sub

Sub boordcomputer()
  Dim sq, s0 As String
  Sheets("boordcomputer").ListObjects(1).DataBodyRange.Columns(1).Name = "br"
  With Sheets("controle")
    s0 = Join(Filter([transpose(if((br=controle!b1)*(offset(br,,4)=controle!B2),row(br),"~"))], "~", 0), "|") & "|"
     With .ListObjects(1)
      If .ListRows.Count Then .DataBodyRange.Delete
    If Len(s0) > 0 Then
       sq = Split(s0, "|")
        .Parent.ListObjects(3).Range.Cut .Parent.ListObjects(2).Range.Cells(1).Offset(UBound(sq) + 2)
        .ListRows.Add.Range.Resize(UBound(sq), 9) = Application.Transpose(Application.Index(Sheets("boordcomputer").ListObjects(1).Range, sq, Application.Transpose(Array(20, 3, 8, 10, 11, 14, 19, 17, 18))))
        .Range.Sort .Range.Cells(1, 2), , .Range.Cells(1, 3), , , , , 1
   End If
    End With
  End With
End Sub
 

Bijlagen

  • Pallet_Controle_test.xlsm
    63,9 KB · Weergaven: 12
Ik heb er even naar gekeken, maar ik heb geen flauw idee wat er moet gebeuren.

Ik neem aan dat listobjects(3) naar onderen moet, je vult daarna listobjects(1) waarbij listobjects(2) in de weg staat daar je die laat staan.
Graag een betere uitleg hier over en dan is er vast wel iemand die het voor je fikst.
 
Het is de bedoeling dat ListObject (2) mooi aansluit bij ListObject (1) wat nu al gebeurd (2 lege rijen tussen) met "Zoek"
zelfde wil ik tussen ListObject (3) en (2) met "Boordcomputer"
 
Zo bedoel je?
Code: 
Sub boordcomputer()
  Dim sq, s0 As String
  Sheets("boordcomputer").ListObjects(1).DataBodyRange.Columns(1).Name = "br"
  With Sheets("controle")
    s0 = Join(Filter([transpose(if((br=controle!b1)*(offset(br,,4)=controle!B2),row(br),"~"))], "~", 0), "|") & "|"
     With .ListObjects(2)
      If .ListRows.Count Then .DataBodyRange.Delete
    If Len(s0) > 0 Then
       sq = Split(s0, "|")
        .Parent.ListObjects(3).Range.Cut .Range.Cells(1).Offset(UBound(sq) + 2)
        .ListRows.Add.Range.Resize(UBound(sq), 9) = Application.Transpose(Application.Index(Sheets("boordcomputer").ListObjects(1).Range, sq, Application.Transpose(Array(20, 3, 8, 10, 11, 14, 19, 17, 18))))
        .Range.Sort .Range.Cells(1, 2), , .Range.Cells(1, 3), , , , , 1
   End If
    End With
  End With
End Sub
 
Laatst bewerkt:
HSV,
voor de eerste wagen werkt dit goed. Doch als een volgende wagen meer rijen bevat en ge drukt op "zoek" dan schuift ListObject (2) op doch ListObject (3) niet met als gevolg dat "boordcomputer" dan niet meer werkt omdat ListObject (2) en (3) over mekaar staan na "zoek"
 
Dan moet met de code 'zoek' ook de derde tabel naar beneden gezet worden.
Ik heb de codes in het bestand staan zodat je kunt zien dat ze in module1 staan en niet achter bladmodule controle.
 

Bijlagen

  • Pallet_Controle_test.xlsb
    51,1 KB · Weergaven: 17
Thanks HSV, jaloers hoe simpel het allemaal voor u lijkt :)
ga script even grondiger bestuderen, weer wat geleerd....
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan