セルのアドレスを取得し、シート上の他のセルの範囲内の値からそのアドレスを（文字列として？）検索するセクションを既存のマクロ内に追加する必要があります-次に、そのセルの値を使用するために1つの列をオフセットしますアドレスが検索されたセルの元の値を置き換えます。
私のコードはマージされていないセルを探しています。マージされていないセルが見つかったら、そこに入れる正しい値を取得する必要があります。私の範囲mCell内のすべてのセルがマージされていないわけではないので、これはループ内の検索/置換です。
セルをハードコーディングできません。また、範囲内を正常に移動し、ワークシートの別の部分の値を使用して検索/置換する機能ループを理解できません。私はVBAを初めて使用し、エラーが発生し続け、データを引き継ぐために1ダースの範囲と文字列を定義することになります。どんな助けでも大歓迎です！
例えば：
マージされていないmCell.address="B20"の場合、マクロは指定された範囲で値 "B20"を検出し（以下の例ではセルQ20で検出されました）、1列をオフセットして（セルR20に）、次の値を使用します。そのセル（6）は、B20の新しいセル値（つまり、アクティブなmCell）= 6になるように、mcellの値を置き換えます。次に、次のマージされていない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
提案をありがとうございます。私の既存のコードは「パートII」まではうまく機能しますが、その後は惨めに失敗し、コードを修正/改善する方法について具体的な支援を求めています。既存のコードは次のとおりです。
' 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