Question

我试图创建一个函数来执行以下操作：

遍历我的工作表中的所有数据集
循环浏览数据集中的每一列
查看该列的标题，并检查它是否在我的列表中。
查找其他各种列，但这次使用.Find
现在遍历该特定数据集的列中的每一行
使用 第4点 中的列引用和 第5点 中的行来放置单元格＆＃ 39; s成为将在步骤7中使用的变量，该变量将在最初找到的列中插入格式化的注释（对于该行）。

我尝试过使用我在其他网站上找到的代码，但我无法正常工作，我被困在第5部分。

数据示例可能如下所示：

我尝试过的代码如下：

 Sub ComTest()

    COMLIST = ";Cond;"

    Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    For Each a In rng.SpecialCells(xlCellTypeConstants).Areas
        With a.CurrentRegion
            Set r = .Rows(1)
            For j = 1 To r.Columns.Count
                TitleCell = r.Cells(j).Address
                v = ";" & Range(TitleCell).Value & ";"
                 '-----------------------------------------------------------------------------------------
                 If InStr(1, COMLIST, v) Then
                    On Error Resume Next

                    xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
                    For i = 1 To UBound(xRange)
                        v = b.Value
                    Next i

                    Condw = r.Columns.Find(Replace(v, ";", "") & " " & "w", lookAt:=xlWhole).Column
                    Condw = .Cells(r, Condw).Address
                    ' Add more stuff here

                 End If
                '-----------------------------------------------------------------------------------------
           Next j
        End With
    Next a

End Sub

对于第7部分，＆＃34;第1行和第34行的输出基本上如下：但这部分我应该能够做到，这是我正在努力的循环部分。

Answer 1

这个问题提出了一些观点，即这个答案可能会在未来为您和其他人解决：

我注意到你之前的问题中没有多少人接受了答案，而且他们中的一些人提出了答案，但你需要做出回应，说出由于某种原因它并不适合你的需要。它表明你并没有在你的问题中提供正确的细节。我认为这就是问题所在。也许您可以概述您要实现的结果，特别是对于Excel VBA，您可以概述电子表格数据的精确结构。很容易在这个问题中思考，您只是想知道如何将C列的值取为F，并将它们写入B列中包含数据的任何行的注释。
使用Web代码通常比从第一原理学习代码语法需要更多时间来理解和适应。您提供的代码很难遵循，有些部分看起来很奇怪。我想知道，例如，这个片段的意图是什么：
```
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
    v = b.Value
Next i
```
在模块顶部使用Option Explicit（这会强制您声明变量）使VBA编码和调试变得更加容易，如果我们可以看到哪些数据，那么在SO上提交的代码更容易理解你想要变量的类型。

如果您的问题仅仅是＆＃34;如何将C列的值取为F并将它们写入B列中的单元格以查找包含数据的任何行？＆＃34;，那么您的代码可以是简单如：

Dim condCol As Range
Dim cell As Range
Dim line1 As String
Dim line2 As String
Dim cmt As Comment

'Define the "Cond" column range
'Note: this is an unreliable method but we'll use it here for the sake of brevity
Set condCol = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns("B")

'Delete any comment boxes
condCol.ClearComments

'Loop through the cells in the column and process the data if it's a number
For Each cell In condCol.Rows
    If Not IsEmpty(cell.Value) And IsNumeric(cell.Value) Then
        'Acquire the comment data
        line1 = "Cond: " & cell.Offset(, 1).Value & "/" & cell.Offset(, 2).Value & _
                " (" & Format(cell.Offset(, 3), "0.00%") & ")"
        line2 = "Cond pl: $" & cell.Offset(, 4).Value
        Set cmt = cell.AddComment(line1 & vbCrLf & line2)
        'Format the shape
        With cmt.Shape.TextFrame
            .Characters(1, 5).Font.Bold = True
            .Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
            .AutoSize = True
        End With
    End If
Next

另一方面，如果您的问题是您的电子表格中存在不可靠的数据，并且您唯一确定的是标题存在于任何一行，那么必须添加某种形式的搜索例程。在这种情况下，您的代码可能如下所示：

Dim rng As Range
Dim rowRng As Range
Dim cell As Range
Dim condCol(0 To 4) As Long
Dim line1 As String
Dim line2 As String
Dim allHdgsFound As Boolean
Dim i As Integer
Dim cmt As Comment

Set rng = ThisWorkbook.Worksheets("Sheet1").UsedRange

rng.ClearComments

For Each rowRng In rng.Rows

    If Not allHdgsFound Then
        'If we haven't found the headings,
        'loop through the row cells to try and find them
        For Each cell In rowRng.Cells
            Select Case cell.Value
                Case Is = "Cond": condCol(0) = cell.Column
                Case Is = "Cond w": condCol(1) = cell.Column
                Case Is = "Cond r": condCol(2) = cell.Column
                Case Is = "Cond %": condCol(3) = cell.Column
                Case Is = "Cond wpl": condCol(4) = cell.Column
            End Select
        Next

        'Check if we have all the headings
        'by verifying the condCol array has no 0s
        allHdgsFound = True
        For i = 0 To 4
            If condCol(i) = 0 Then
                allHdgsFound = False
                Exit For
            End If
        Next

    Else

        If Not IsEmpty(rowRng.Cells(1).Value) Then

            'The cell has values so populate the comment strings
            line1 = "Cond: " & rowRng.Columns(condCol(1)).Value & "/" & _
                    rowRng.Columns(condCol(2)).Value & _
                    " (" & Format(rowRng.Columns(condCol(3)).Value, "0.00%") & ")"
            line2 = "Cond pl: $" & rowRng.Columns(condCol(4))
            Set cmt = rowRng.Columns(condCol(0)).AddComment(line1 & vbCrLf & line2)
            'Format the shape
            With cmt.Shape.TextFrame
                .Characters(1, 5).Font.Bold = True
                .Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
                .AutoSize = True
            End With

        Else

            'We've reached a blank cell so re-set the found values
            allHdgsFound = False
            Erase condCol

        End If

    End If

Next

当然，您的数据可能采用多种其他方式构建，但我们并不知道。我的观点是，如果您在问题中更具体，并提供您想要达到的结果，您可能会收到对您更有用的答案。

循环访问数据集，列和行，以根据其他单元格添加注释

1 个答案: