ディクショナリに列アドレスが含まれているため、指定されたセルに移動しようとしてディクショナリをループしているときにエラーが発生します。ここに少し背景があります-
- コメントのあるセルをループします (一番上の行のみ!!)
- その列とコメント テキストをディクショナリ オブジェクトに格納する
- 残りの行をループし、最初の行のコメントと同じ列のセルにのみ移動します。この情報は、別のワークシートに送信されます
例えば、
|CELL1|CELL2 (W コメント)|CELL3|
--Cell2
列アドレス 2 とコメントを格納し、列位置 2 で次のセルを選択します。
クラス全体を投稿しましたが、注意する必要がある部分は、コメント付きのコードの一番下にあります。おそらくコードには少し重いと思いますので、ショートカットを見つけたらアドバイスしてください!
Option Explicit
Public buildWs As Worksheet
Public targWs As Worksheet
Public CommentVal As Comment
Public FirstRow As Range
Public targLastrow As Range
Public firstRecordRow As Range
Public commRange As Range
Public commCell As Range
Public recordRow As Range
Public LastRow As Long
Public vertRange As Range
Public vertCell As Range
'//---------------------------------------
'//getter and setter methods of the class
Public Property Get ItemNum() As Comment
ItemNum = CommentVal
End Property
Public Property Let ItemNum(Value As Comment)
CommentVal = ItemNum
End Property
Public Property Get Start() As Range
Start = FirstRow
End Property
Public Property Let Start(Value As Range)
Set FirstRow = Value
End Property
Public Property Get affBuild() As Worksheet
affBuild = buildWs
End Property
Public Property Let affBuild(Value As Worksheet)
Set buildWs = Value
End Property
Public Property Get allinaBuid() As Worksheet
allinaBuild = targWs
End Property
Public Property Let allinaBuild(Value As Worksheet)
Set targWs = allinaBuild
End Property
Public Sub setId()
Dim rowCount As Integer
Dim element As Variant
Dim n As Integer
Dim z As Integer
Dim keyValue As New Dictionary
Dim col As String
On Error Resume Next
Set commRange = buildWs.Cells _
.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If commRange Is Nothing Then
MsgBox "No Comments Found"
Exit Sub
End If
buildWs.Activate
For Each commCell In commRange
commCell.Select
'// do something here with the cell since it meets our criteria of having a comment
keyValue.Add ActiveCell.Column, ActiveCell.Comment.Text
Next commCell
'// loop through the vertical range for the 1st column to get a count of rows
'//--------------------------------------------------------------------------
Set vertRange = Range("A:A")
vertRange.Select
For Each vertCell In vertRange
If ActiveCell.Value = "" Then
Exit For
Else
rowCount = rowCount + 1
ActiveCell.Offset(1, 0).Select
End If
Next vertCell
'// row count is off by one since we don't care about the first row
rowCount = rowCount - 1
'// select the first real row we care about as row1 is only header info
FirstRow.Select
For Each element In keyValue
col = element
MsgBox col '<-- this displays the correct dictionary information -->
Cells("2", col).Select '<-- this fails and gives me an error! -->
Next element
End Sub