我需要在现有宏中添加一个部分,该部分获取单元格的地址并从工作表上其他位置的单元格范围内的值中查找该地址(作为字符串?) - 然后偏移一列以使用该单元格的值替换搜索地址的单元格的原始值。
我的代码正在寻找未合并的单元格,当它找到未合并的单元格时,它需要获取正确的值以放入其中。并非我的范围 mCell 中的所有单元格都未合并,因此这是循环中的查找/替换。
我无法对单元格进行硬编码,也无法找出成功通过我的范围并使用工作表另一部分的值查找/替换的功能循环。我是 VBA 的新手,不断收到错误,最终定义了十几个范围和字符串,试图传递数据。任何帮助将不胜感激!
例如:
如果未合并的 mCell.address = "B20",则宏在指定范围内找到值 "B20"(在下面的示例中,在单元格 Q20 中找到),然后偏移一列(到单元格 R20),然后使用值该单元格(即 6)替换 mcell 的值,使得 B20(即活动 mCell)的新单元格值 = 6。然后转到下一个未合并的 mCell...
row Column Q Col. R '(not code, but can't get formatting any other way)
18 B18(text) 5
19 B19 4
20 B20 6
21 B21 3
感谢您的任何建议,我现有的代码在“第二部分”之前运行良好,但后来我惨遭失败,并请求有关如何更正/改进代码的具体帮助。现有代码是:
' This sub looks for the word "Table" in column A. If the word appears, it unmerges the cells in columns B - E
' and the rows following to allow for the insert of a table, then merges all other rows for sake of format.
Option Explicit
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Range("B14:E64").SpecialCells(xlCellTypeVisible).Select
With Selection
.RowHeight = 17
.VerticalAlignment = xlTop
.HorizontalAlignment = xlLeft
.WrapText = True
End With
'*******Merge or unmerge rows according to whether or not they contain Table data -
' this only acts on visible cells, so rows of data table can be hidden as needed
Dim TA As Integer
Dim ColValues As Variant
Dim rng As Range
Dim tabNo As Range 'uses value on worksheet to know how many rows to unmerge
'*******Dims in finding and replacing unmerged cell values
Dim mergeRange As Range 'Range B16:E64 - where my mCells are being pulled from
Dim mCell As Range 'Cell that is unmerged, looking for its address
Dim ws As Worksheet
Dim tabledata As Range 'Range Q11:Q38 - this is the column I'm searching in and offsetting from
Dim aCell As String 'picks up cell address, to use in .find
Dim myCell As Range 'cell address in Q
Dim ReplaceString As String
Dim foundCell As Range
Dim bCell As Range
Dim i As Long
Application.DisplayAlerts = False
'Make column B = Column A values, cannot make this happen on sheet, because data is too variable
ColValues = ActiveSheet.Range("A16:A64").Value
ActiveSheet.Range("B16:B64").Value = ColValues
'Look for data table, if not present, merge cells
Set rng = ActiveSheet.Range("B14:B100")
Set tabNo = ActiveSheet.Range("K6")
For TA = 15 To 64 'defines TA variable to loop from row 14 to row 64
If Cells(TA, "A") = "Table" Then '
Range("B" & TA & ":E" & TA + tabNo).UnMerge 'unmerges the row with "Table" listed and the next 7 rows (to make a 8-row x 4 column unmerged area for table
TA = TA + tabNo ' moves active cell "TA" down 7 spaces
Else
Range("B" & TA & ":E" & TA).Merge 'If "Table" not found, then merge the cells for the row TA is in across columns B:E
End If
Next TA
'*** Part II: Need some calculation to loop or offset or find through data and fill
'unmerged cells from a data table on the worksheet.
'the placement of the data table varies depending on the layout of the report,
'which changes day to day, so can not be hard coded into the cells - needs to look up
'position of the word "Table" and dump data after that.
'offset? .find? loop?
'***want to take the cell address of each unmerged cell within the range of the report
'and look for that cell in an array, then replace the cell contents with the correct value
Set mergeRange = ActiveSheet.Range("B16:E64")
For Each mCell In mergeRange
' If mergeRange.MergeCells = True Then
' MsgBox "all cells are merged, exiting sub"
' Exit Sub
'Else
If mCell.MergeCells = False Then
aCell = mCell.Address '??? Need to set the cell address as
'a text string or something in order to look for that address in the values
'of cells in range "tabledata"
'MsgBox "aCell " & Range(aCell).Address
Set tabledata = ActiveSheet.Range("Q11:Q38")
Set bCell = tabledata.Find(aCell, After:=Range("Q1"), LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'this gives me a "type mismatch" error that I cannot clear
'- then wanting the value of the cell offset one column over
'need to take the value of that offset cell and use it
'to replace the value of the original unmerged cell (mCell)
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 1).Value = ActiveCell.Value
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Next mCell
End Sub