セルから情報を抽出するExcelループ

Question

私はこの表1を持っており、表2の結果を達成しようとしています。

現在のデータ：

|     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) 

期待される結果：

|   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 

私は助けを必要と何がA列とX + 5行を見つけ、D列3にコピーするループであります一意のjpg名ごとに時間を減らしてください。

R G B列については、細胞から情報を抽出する式が見つかりました。 B

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

についてはG

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

についてはR

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

については

それはからのエラーをヒットしないように、ループのコードにこれを追加する方法はあります空白と.jpgセル？

おかげ

Answer 1

と同じ長さを有している前提としていますあなたのタグにVBAがあります。ここにはVBAソリューションがあります。コード内

注wsResとrResを変更することで、好きな場所あなたは、あなたが出力を置くことができ、特定の参照を設定し、また定期的なモジュールでcRGB

にクラスモジュールの名前を変更する必要があることコメント（ワークシートと結果の範囲の左上のセル）をモジュールの先頭近くに配置します。

これはあなたが上記のものを正確に出力します。

• このコードでは、正規表現を使用してコンポーネントを抽出しています。
• このデータを循環し、各オブジェクトは、関連するRGBのコレクション（辞書）と一緒.JPGエントリから構成
• が
• クラスオブジェクト値.JPGエントリを見つけるたびに、新しいクラスのオブジェクトを起動します辞書に集められる。

上記の方法は、出力をより簡単に作成し、将来のニーズに合わせて変更しやすくします。

クラスモジュール

'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 

正規モジュール

'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

それはあなたが最初に閉じ括弧まで最初のカンマから部分文字列を取っているので、Bが124113を返すという意味があります。次のソリューションは厄介ですが、それは動作します：

は

=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) 

上記は、実質的に最初のカンマまでのすべてのものを除外したサブストリングを使用してA2の参照を置き換えます。関数を別々の2つのセルに分割すると、よりクリーンで分かりやすくなります。列Xは、以下の式を含むことができる。例えば

：

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

そしてBは、以下のようになる。

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

はまたあなたのGは、それがためR.