Excel-Schleife, um Informationen aus Zellen zu extrahieren

Question

Ich habe diese Tabelle1 und versucht, die Ergebnisse von Tabelle2 zu erreichen.

Aktuelle Daten:

|     A       | 
150112 Charlston.jpg  
281320: (143,124,113) #8F7C71 srgb(143,124,113) 
1408099: (178,161,151) #B2A197 srgb(178,161,151)  
1685636: (200,183,173) #C8B7AD srgb(200,183,173)  

218600.jpg 
4385653: (29, 23, 29) #1D171D srgb(29,23,29) 
2192865: (76, 47, 69) #4C2F45 srgb(76,47,69) 
1409815: (96, 84,100) #605464 srgb(96,84,100) 

218622.jpg 
1519955: (30, 56, 57) #1E3839 srgb(30,56,57) 
1551616: (33, 62, 65) #213E41 srgb(33,62,65) 
2118603: (34, 58, 59) #223A3B srgb(34,58,59) 

Erwartete Ergebnisse:

|   E   | F | G | H | 

         R G B 
150112 Charlston.jpg 143 124 113 
150112 Charlston.jpg 178 161 151 
150112 Charlston.jpg 200 183 173 
218600.jpg    29 23 29 
218600.jpg    76 57 69 
218600.jpg    96 84 100 
218622.jpg    30 56 57 
218622.jpg    33 62 65 
218622.jpg    34 58 59 

Was brauche ich Hilfe bei der Looping die A-Säule des Findens und x + 5 Reihe und kopiert es in D-Säule 3 mal nach unten für jeden eindeutigen jpg-Namen.

Wie für die R G B Spalte habe ich die Formel für die Extraktion der Informationen aus den Zellen gefunden.

Für R

=MID($A2,FIND("(",$A2)+1,FIND(",",$A2)-FIND("(",$A2)-1) 

Für G

=MID($A2,FIND(",",$A2)+1,FIND(",",$A2)-FIND("(",$A2)-1) 

Für B

=MID($A2,(FIND(CHAR(7),SUBSTITUTE($A2,",",CHAR(7),4)))+1,(LEN($A2))-1-(FIND(CHAR(7),SUBSTITUTE($A2,",",CHAR(7),4)))) 

Gibt es eine Möglichkeit, dies in den Looping-Code hinzufügen, so dass es einen Fehler nicht treffen würde aus die leeren und .jpg Zellen?

Dank

Answer 1

hat seit Sie haben VBA in Ihren Tags, hier ist eine VBA-Lösung.

Hinweis im Code kommentiert, dass Sie bestimmte Verweise setzen haben, und auch die Klasse-Modul Im regulären Modul cRGB

umbenennen, können Sie die Ausgabe setzen wo immer Sie wollen, durch wsRes verändern und rRes (Arbeitsblatt und obere linke Zelle des Bereichs für die Ergebnisse) nahe dem Anfang des Moduls.

Es gibt genau das aus, was Sie oben zeigen.

• Der Code verwendet reguläre Ausdrücke, um die Komponenten zu extrahieren.
• Es Zyklen durch die Daten und startet ein neues Klassenobjekt, wenn es den .jpg-Eintrag findet
• Jedes Objekt besteht aus dem .jpg Eintrag zusammen mit einer Sammlung (Wörterbuch) der zugehörigen RGB-Wert
• Die Klassenobjekte sind in einem Wörterbuch gesammelt.

Die obige Methode macht das Erstellen der Ausgabe einfacher und einfacher für zukünftige Anforderungen zu ändern.

Klassenmodul

'Rename this module: cRGB 

Option Explicit 

Private pJPG As String 
Private pR As Long 
Private pG As Long 
Private pB As Long 
Private pRGB As String 
Private pRGBs As Dictionary 

Private Sub Class_Initialize() 
    Set pRGBs = New Dictionary 
End Sub 

Public Property Get JPG() As String 
    JPG = pJPG 
End Property 
Public Property Let JPG(Value As String) 
    pJPG = Value 
End Property 

Public Property Get R() As Long 
    R = pR 
End Property 
Public Property Let R(Value As Long) 
    pR = Value 
End Property 

Public Property Get G() As Long 
    G = pG 
End Property 
Public Property Let G(Value As Long) 
    pG = Value 
End Property 

Public Property Get B() As Long 
    B = pB 
End Property 
Public Property Let B(Value As Long) 
    pB = Value 
End Property 

Public Property Get RGB() As String 
    RGB = pRGB 
End Property 
Public Property Let RGB(Value As String) 
    pRGB = Value 
End Property 

Public Property Get RGBs() As Dictionary 
    Set RGBs = pRGBs 
End Property 
Public Function addRGBsItem() 
    Dim V(2) As Variant 
     V(0) = Me.R 
     V(1) = Me.G 
     V(2) = Me.B 
     RGBs.Add Join(V, ","), V 
End Function 

reguläres Modul

'Set References to 
' Microsoft Scripting Runtime 
' Microsoft VBScript Regular Expressions 5.5 
Option Explicit 

Sub getRGB() 
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range 
    Dim vSrc As Variant, vRes As Variant 
    Dim dR As Dictionary, cR As cRGB 
    Dim RE As RegExp, MC As MatchCollection, M As Match 
    Const spatJPG As String = "^.*\.jpg\s*$" 
    Const spatRGB As String = "\((\d+),(\d+),(\d+)\)\s*$" 
    Dim S As String, V As Variant, W As Variant, I As Long 

'Set source and results worksheets 
' results range 
' Read source into vba array 
Set wsSrc = Worksheets("Sheet") 
Set wsRes = Worksheets("sheet1") 
    Set rRes = wsRes.Cells(1, 1) 

With wsSrc 
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) 
End With 

'Initialize dictionary 
Set dR = New Dictionary 
    dR.CompareMode = TextCompare 

'Initialize Regex 
Set RE = New RegExp 
With RE 
    .IgnoreCase = True 
    .MultiLine = True 

'cycle through the source data 
    For Each V In vSrc 
     If Not V = "" Then 
      .Pattern = spatJPG 
      If .Test(V) = True Then 
       S = V 
       Set cR = New cRGB 
        cR.JPG = S 
        dR.Add Key:=S, Item:=cR 
      Else 
       .Pattern = spatRGB 
       If .Test(V) = True Then 
        Set MC = .Execute(V) 
         With MC(0) 
          dR(S).R = .SubMatches(0) 
          dR(S).G = .SubMatches(1) 
          dR(S).B = .SubMatches(2) 
         End With 
         dR(S).addRGBsItem 
       End If 
      End If 
     End If 
    Next V 
End With 

'size results array 
I = 0 
For Each V In dR.Keys 
    I = I + dR(V).RGBs.Count 
Next V 

ReDim vRes(0 To I, 1 To 4) 

'Header Row 
vRes(0, 1) = "" 
vRes(0, 2) = "R" 
vRes(0, 3) = "G" 
vRes(0, 4) = "B" 

'Populate the data 
I = 0 
For Each V In dR.Keys 
    For Each W In dR(V).RGBs.Keys 
     I = I + 1 
     vRes(I, 1) = dR(V).JPG 
     vRes(I, 2) = Split(W, ",")(0) 
     vRes(I, 3) = Split(W, ",")(1) 
     vRes(I, 4) = Split(W, ",")(2) 
    Next W 
Next V 

Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2)) 
With rRes 
    .EntireColumn.Clear 
    .Value = vRes 
    With .Rows(1) 
     .Font.Bold = True 
     .HorizontalAlignment = xlCenter 
    End With 
    .EntireColumn.AutoFit 
End With 

End Sub 

Answer 2

Es macht Sinn, dass B 124.113 zurück, weil Sie einen Teilstring aus dem ersten Komma, bis der ersten Schließbügel nehmen. Die folgende Lösung ist etwas chaotisch, aber es funktioniert:

=MID(MID($A2,FIND(",",$A2)+1,LEN(A2)-FIND(",",$A2)),FIND(",",MID($A2,FIND(",",$A2)+1,LEN(A2)-FIND(",",$A2)))+1,FIND(")",MID($A2,FIND(",",$A2)+1,LEN(A2)-FIND(",",$A2)))-FIND(",",MID($A2,FIND(",",$A2)+1,LEN(A2)-FIND(",",$A2)))-1) 

Die oben praktisch ersetzt Ihre A2 Referenz mit einem Teil, das alles bis zum ersten Komma ausschließt. Es ist sauberer und einfacher zu verstehen, wenn Sie die Funktion auf zwei separate Zellen aufteilen.

Zum Beispiel Spalte X kann die folgende Formel:

=MID($A2,FIND(",",$A2)+1,LEN(A2)-FIND(",",$A2)) 

Dann B wird:

=MID(X2,FIND(",",X2)+1,FIND(")",X2)-FIND(",",X2)-1) 

Beachten Sie auch, dass Ihr G nimmt gleiche Länge wie R.