Oplopend Sorteren (VBA) speelt parten in de lengte van de tekst

[DANIEL162]

Winkels hebben een reeks aantal weerstanden in stock. Maar worden niet altijd op dezelfde mannier geformuleerd.

Deze formule werkt niet in deze

ARC MRA0207 100K Metaalfilmweerstand, 100 kOhm, 0207, 250 mW, 0,1%
ARC MRA0207 100R Metaalfilmweerstand, 100 Ohm, 0207, 250 mW, 0,1%
ARC MRA0207 10K Metaalfilmweerstand, 10 kOhm, 0207, 250 mW, 0,1%
ARC MRA0207 10K2 Metaalfilmweerstand, 10,2 kOhm, 0207, 250 mW, 0,1%
ARC MRA0207 110R Metaalfilmweerstand, 110 Ohm, 0207, 250 mW, 0,1%
ARC MRA0207 121R Metaalfilmweerstand, 121 Ohm, 0207, 250 mW, 0,1%
ARC MRA0207 12K1 Metaalfilmweerstand, 12,1 kOhm, 0207, 250 mW, 0,1%
Metaalfilmweerstand, 1,0 kOhm, 0207, 250 mW, 0,1%
Metaalfilmweerstand, 1,0 kOhm, axiaal, 250 mW, 0,1%
Metaalfilmweerstand, 1,0 kOhm, axiaal, 500 mW, 0,1%
Metaalfilmweerstand, 1,0 MOhm, 0207, 250 mW, 0,1%
Metaalfilmweerstand, 1,1 kOhm, 0207, 250 mW, 0,1%
Metaalfilmweerstand, 1,4 kOhm, 0207, 250 mW, 0,1%
MPR 7,50K Precisie-weerstand, 0,6W, 0,1%, 7,5 kilo-ohm
MPR 8,20K Precisie-weerstand, 0,6W, 0,1%, 8,2 kilo-ohm
MPR 82,0 Precisie-weerstand, 0,6W, 0,1%, 82,0 ohm
MPR 82,0K Precisie-weerstand, 0,6W, 0,1%,82 kilo-ohm
MPR 820 Precisie-weerstand, 0,6W, 0,1%, 820 ohm
MPR 9,10K Precisie-weerstand, 0,6W, 0,1%, 9,1 kilo-ohm
MPR 91,0K Precisie-weerstand, 0,6W, 0,1%,91 kilo-ohm
Precisie-weerstand, 0,6W, 0,1%, 680 ohm
Precisie-weerstand, 0,6W, 0,1%, 82,0 ohm
Precisie-weerstand, 0,6W, 0,1%, 820 ohm
Precisie-weerstand, 0,6W, 0,1%,150 ohm
Precisie-weerstand, 0,6W, 0,1%, 1,0 Mohhm
Precisie-weerstand, 0,6W, 0,1%, 1,0 kilo-ohm
Precisie-weerstand, 0,6W, 0,1%, 1,1 kilo-ohm
Precisie-weerstand, 0,6W, 0,1%, 1,3 kilo-ohm

Sub Sorteren__01_procent_Metalen_weerstanden()
Dim R, Ra As Range
With CreateObject("System.Collections.ArrayList")
  Set Ra = [A1].CurrentRegion
  For Each R In Ra
    s = Split(Replace(R, ".", ","))
    w = s(1) * IIf(s(2) = "Kohm", 1000, IIf(s(2) = "Mohm", 1000000, 1))
    temp = s(0) & Format(w, " 000000000000000 ") & s(2) & "|" & R
    .Add temp
  Next
  .Sort
  a = .toarray()
  For N = 0 To UBound(a)
    s = Split(a(N), "|")
    a(N) = s(1)
  Next
  Ra = WorksheetFunction.Transpose(a)
End With
End Sub

Het is de bedoeling dat alle weerstanden in van kolom A gesorteerd worden Ohm daaronder KOhhm en tenslotte MOhm.

------------------------------------
PS De formule werkt wel als dit hieronder geformuleerd

RC 33 ohm metaalfilmweerstand 1/4 watt
RC 36 ohm metaalfilmweerstand 1/4 watt
RC 39 ohm metaalfilmweerstand 1/4 watt
RC 43 ohm metaalfilmweerstand 1/4 watt
RC 510 Kohm metaalfilmweerstand 1/4 watt
RC 560 Kohm metaalfilmweerstand 1/4 watt
RC 620 Kohm metaalfilmweerstand 1/4 watt
RC 680 Kohm metaalfilmweerstand 1/4 watt
RC 4,7 Mohm metaalfilmweerstand 1/4 watt
RC 5,6 Mohm metaalfilmweerstand 1/4 watt
RC 8,2 Mohm metaalfilmweerstand 1/4 watt
RC 10 Mohm metaalfilmweerstand 1/4 watt

 

[snb]

Al sinds 2011 (10 Jaar !. proficiat) op dit forum, en nog steeds niet in staat:
- een fatsoenlijke vraag te stellen,
- gegevens in een voorbeeldbestand te zetten,
- een voorbeeldbestand te plaatsen.

T'is toch wat.

 

[AccessGuru]

Vind je het gek dat het niet werkt? Je hebt de mogelijke Ohm aanduiding in vijf verschillende kolommen staan; dat gaat natuurlijk nooit werken op deze manier. Daarnaast is voor geen enkele computer kilo-ohm hetzelfde als kohm. Kortom: Garbage In --> Garbage out.

 

[sylvester-ponte]

zat een foutje in:

Sub Sorteren__01_procent_Metalen_weerstanden()
Dim R, Ra As Range
With CreateObject("System.Collections.ArrayList")
  Set Ra = [A1].CurrentRegion
  For Each R In Ra
    s = WorksheetFunction.Search("oh*m", R)
    For n = s - 1 To 1 Step -1
      t = Mid(R, n, 1)
      If t = " " Then Exit For
    Next
    temp = Trim(Mid(R, n, s - n + 3))
    w = 1
    If LCase(Left(temp, 1)) = "k" Then w = 1000
    If LCase(Left(temp, 1)) = "m" Then w = 1000000
    L = 1
    For n = n - 1 To 1 Step -1
      t = Mid(R, n, L)
      If IsNumeric(t) Then
          L = L + 1
      Else
        If Mid(R, n + 1, 1) = "," Then n = n + 1: L = L - 1
        temp = Trim(Mid(R, n + 1, L - 1)) * w
        Exit For
      End If
    Next
    temp = Format(temp, "000000000000000 ") & "|" & R
    .Add temp
  Next
  .Sort
  a = .toarray()
  For n = 0 To UBound(a)
    s = Split(a(n), "|")
    a(n) = s(1)
  Next
  Ra.Offset(, 6) = WorksheetFunction.Transpose(a)
End With
End Sub

 

[DANIEL162]

Formidable formidable, Dikke pluim Sylvester:thumb:
Het wordt gesorteerd in kolom G Kolom A blijft ook staan. Goed gedaan.
Niets meer op te merken of te veranderen. Nogmaals een dikke merci
Prettige feesdagen!

 

[snb]

Met een beetje middelbare school wiskunde (klas 3):

ipv

    w = 1
    If LCase(Left(temp, 1)) = "k" Then w = 1000
    If LCase(Left(temp, 1)) = "m" Then w = 1000000

Sub M_snb()
  w = 10 ^ InStr("  k  m", Left(LCase(temp), 1))
End Sub

 

[sylvester-ponte]

snb, kan ook, er zijn blijkbaar vele wegen naar Rome.

ik denk LTS tweede klas.

ook fijne feestdagen.