Question

我有这个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 |

                        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行的循环，并将每个唯一的jpg名称复制到D列3次。

至于R G B栏，我找到了从细胞中提取信息的公式。

对于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单元格中找到错误？

由于

Answer 1

由于您的代码中包含VBA，因此这是一个VBA解决方案。

请注意，在代码注释中您必须设置某些引用，并将类模块重命名为cRGB

在常规模块中，您可以通过在模块开头附近更改wsRes和rRes（工作表以及结果范围的左上角单元格）将输出放在任意位置。

它完全输出您在上面显示的内容。

代码使用正则表达式来提取组件。
循环访问数据并在找到.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

Answer 2

B返回124,113是有道理的，因为你从第一个逗号到第一个右括号的子字符串。以下解决方案很麻烦但是有效：

=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引用，该子字符串排除了第一个逗号之外的所有内容。如果将功能拆分为两个单独的单元格，它会更清晰，更容易理解。

例如，列X可以包含以下公式：

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

然后B成为：

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

另请注意，您的G假设其长度与R相同。

Excel循环从单元格中提取信息

2 个答案: