Excel循环从单元格中提取信息
我有这个Table1并试图实现Table2的结果。
当前数据：
| 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 | RGB 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
我需要帮助的是循环findA列和X + 5行，并将其复制到D列3下每个独特的JPG名称。
至于RGB列，我find了从单元格中提取信息的公式。
对于R
=MID($A2,FIND("(",$A2)+1,FIND(",",$A2)-FIND("(",$A2)-1)
对于G
=MID($A2,FIND(",",$A2)+1,FIND(",",$A2)-FIND("(",$A2)-1)
对于B
=MID($A2,(FIND(CHAR(7),SUBSTITUTE($A2,",",CHAR(7),4)))+1,(LEN($A2))-1-(FIND(CHAR(7),SUBSTITUTE($A2,",",CHAR(7),4))))
有没有办法将这个添加到循环代码，所以它不会从空白和.jpg单元格中的错误？
谢谢
由于您的代码中包含VBA，因此以下是VBA解决scheme。
请注意，在代码注释中，您必须设置某些引用，并将类模块重命名为cRGB
在常规模块中，通过在模块的开头附近更改wsRes和rRes （工作表和结果范围的左上angular单元格），可以将输出放在wsRes rRes 。
它输出正是你上面显示的。
- 代码使用正则expression式来提取组件。
- 它循环访问数据，并在find.jpg条目时启动一个新的类对象
- 每个对象由.jpg条目以及关联的RGB值的集合（字典）组成
- 类对象被收集在一个字典中。
上述方法使得输出更简单，易于修改以满足将来的需要。
类模块
'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
B返回124,113是有意义的，因为你从第一个逗号开始直到第一个右括号。 下面的解决scheme是混乱的，但它的工作原理：
=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)
上面实际上用一个排除了第一个逗号的所有东西的子串replace你的A2引用。 如果将函数分成两个单独的单元格，则它更干净，更容易理解。
例如，列X可以包含以下公式：
=MID($A2,FIND(",",$A2)+1,LEN(A2)-FIND(",",$A2))
然后B变成：
=MID(X2,FIND(",",X2)+1,FIND(")",X2)-FIND(",",X2)-1)
还要注意，你的G假设它和R的长度相同。