Complex filter, knip en plak actie

[mvanbe]

Goedenavond,

Hopelijk ziet iemand dit als een uitdaging, ik kom er niet uit en een oplossing zou me enorm helpen.

In het voorbeeldbestand heb ik een kolom Fabrikant, Type en Omschrijving. In de kolom omschrijving staan in het originele bestand regelmatig het merk en type vermeld. Deze zou ik graag geautomatiseerd naar de bovenstaande kolommen willen plakken.

Iemand enig idee of dit mogelijk is en zo ja; hoe zou ik dit kunnen aanpakken?

 

[VenA]

Volgens mij klopt het bestand niet met de vraag. Met zoeken speciaal kan je het waarschijnlijk wel oplossen.

 

[HSV]

in het originele bestand regelmatig het merk en type vermeld.

Dat is het probleem; ze staan niet in het voorbeeldbestand.

 

[mvanbe]

Klopt. In het voorbeeldbestand zie je in de kolom omschrijving Brand of Merk staan en type; dit zou gekopieerd moeten worden naar de kolom Fabrikant en type.

 

[HSV]

Zou deze code voor je werken?

Sub hsv()
Dim sv, sq, i As Long, j As Long
With Sheets(1).ListObjects(1)
 sv = .DataBodyRange
  ReDim arr(.ListRows.Count, 1)
   For i = 1 To .ListRows.Count
     sq = Split(sv(i, 6), ";")
       For j = 0 To Application.Min(1, UBound(sq) - 1)
         arr(i - 1, j) = Trim(Split(sq(j), ":")(1))
       Next j
    Next i
   With .DataBodyRange.Cells(1, 1).Resize(UBound(arr), 2)
    .ClearContents
    .Value = arr
  End With
 End With
End Sub

 

[mvanbe]

Geweldig; Ik vraag me echt af hoe je dit jezelf eigen maakt…Heb al vrij veel gelezen maar de logica en inzicht ontbreekt mij. Ben onder de indruk!

Nog één verzoek; is er een functie te integreren die in de kolom omschrijving alleen type kopieert als deze er ook daadwerkelijk staat? Nu kopieert hij de eerste 2 ';' parameters\


Hopelijk is het duidelijk wat ik bedoel;

Nogmaals bedankt

 

[VenA]

Probeer het zo eens.

Sub VenA()
  With Sheets(1).ListObjects(1)
    ar = .DataBodyRange
    For j = 1 To UBound(ar)
      ar1 = Split(ar(j, 6), ":")
      ar(j, 1) = Trim(Split(ar1(1), ";")(0))
      If InStr(ar1(1), "type") Then ar(j, 2) = Trim(Split(ar1(2), ";")(0)) Else ar(j, 2) = ""
    Next
    .DataBodyRange = ar
  End With
End Sub

 

[snb]

Of

Sub M_snb()
  With Sheet1.ListObjects(1)
    sn = .DataBodyRange

    For j = 1 To UBound(sn)
      If InStr(sn(j, 6), "type: ") Then sn(j, 2) = Trim(Replace(Filter(Split(sn(j, 6), ";"), "type: ")(0), "type: ", ""))
    Next

    .DataBodyRange = ar
  End With
End Sub

 

[mvanbe]

Alle aangeboden opties helpen. De laatste knipt inderdaad in het voorbeeld bestand prachtig Fabrikant en Type naar de juiste kolom.

Helaas nog niet in mijn originele bestand. Het zal waarschijnlijk een kleine aanpassing zijn of kan dit met de omvang te maken hebben?

Heb het bijgevoegd. Zou het graag zelf beter willen begrijpen/doen maar op dit moment is het pure magie

 

[HSV]

Werkt dit beter?

Sub M_snb_aangepast()
  With Sheets("blad2").ListObjects(1)
    sn = .DataBodyRange
   For j = 1 To UBound(sn)
    brandmerk = IIf(InStr(sn(j, 6), "brand: "), "brand: ", IIf(InStr(sn(j, 6), "merk: "), "merk: ", ""))
      If brandmerk <> "" Then sn(j, 1) = Trim(Replace(Filter(Split(sn(j, 6), ";"), brandmerk)(0), brandmerk, ""))
      If InStr(sn(j, 6), "type: ") Then sn(j, 2) = Trim(Replace(Filter(Split(sn(j, 6), ";"), "type: ")(0), "type: ", ""))
    Next
 .DataBodyRange = sn
  End With
End Sub

 

[mvanbe]

Nee helaas; krijg de foutmelding: subscript valt buiten bereik op de regel: With Blad1.ListObjects(1)

 

[HSV]

Dat krijg je dus als mijn voorganger met de codenaam werkt.
Elk taalversie is anders.

With Sheets("blad2").ListObjects(1)

 

[snb]

Of

Sub M_snb()
   sn = Blad1.UsedRange
   
   For j = 2 To UBound(sn)
      If InStr(sn(j, 6), "type:") And sn(j, 2) = "NA" Then sn(j, 2) = Split(Split(sn(j, 6), "type: ")(1), ";")(0)
      If InStr(sn(j, 6), "brand:") And sn(j, 1) = "NA" Then sn(j, 1) = Split(Split(sn(j, 6), "brand: ")(1), ";")(0)
      If InStr(sn(j, 6), "mark:") And sn(j, 1) = "NA" Then sn(j, 1) = Split(Split(sn(j, 6), "mark: ")(1), ";")(0)
   Next
   
   Blad1.UsedRange = sn
End Sub

Wat ook niet handig is:
codename Blad1; name: Blad2
codename Blad2; name: Blad1

 

[HSV]

Ook weer mooi @snb.

Waar ik gisteren met mijn verstand was......... :shocked:

 

[snb]

Ik zal maar niet over mijn 'dipjes' beginnen ....:d

 

[VenA]

We zullen maar zeggen hoe later de avond hoe schoner het volk. Maar wel de juiste analyse van de vraag.:thumb: