在数据集，列和行之间循环来添加基于其他单元格的注释

我试图做一个function来做到以下几点：

1. 循环浏览我的表格中的所有数据集
2. 循环访问我的数据集中的每一列
3. 查看该列的标题，并检查它是否在我的列表中。
4. find几个其他的列，但这次使用.Find
5. 现在循环访问特定数据集的列中的每一行
6. 使用点4中的列引用和点5中的行将单元格放入将在第7步中使用的variables，该variables将在最初find的列（对于该行）中插入格式化的注释。

我试着从一些不同的网站上find一些代码工作，但是我不能正确的工作，我被困在了第五部分。

数据示例可能如下所示：

我的尝试代码如下所示：

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部分，对于“第1行”，输出本质上如下，但是这一部分我应该能够做到，这是我正在努力的循环部分。

Answer 1

这个问题提出了几点，这个答案可能会在未来为你和其他人解决：

1. 我注意到，你以前的许多问题都没有被接受，他们中的一些人提出了答案，但是你需要回答说，由于某种原因它不适合你的需求。 这表明你没有真正提供你的问题中的正确的细节。 我认为这是事实。 也许你可以概述你想要达到的结果，特别是对于Excel VBA，电子表格数据的精确结构。 在这个问题中思考，你只是想知道如何获取列C到F的值，并将它们写入列B中的任何包含数据的行的注释。

2. 使用网页代码通常需要更多时间来理解和适应，而不是从第一原则学习代码语法。 您提供的代码很难遵循，有些部分看起来很奇怪。 例如，我想知道这个代码片段是做什么的：

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

3. 在你的模块的顶部使用Option Explicit （强制你声明你的variables）使得VBA的编码和debugging变得容易很多，而且在SO上提交的代码更容易理解，如果我们能够看到你所需要的variables的数据types。

如果您的问题仅仅是“如何获取列C到F的值并将它们写入列B中的单元格，以获取包含数据的任何行？”，那么您的代码可能如下所示：

 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 

另一方面，如果您的问题是您的电子表格中有不可靠的数据，并且您唯一可以肯定的是标题存在于任何一行中，则必须添加某种forms的search例程。 在这种情况下，你的代码可能看起来像这样：

 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 

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