別のタブのセルが塗りつぶされたときにのみセルが結合されるように、数式を使用してセルを結合する必要があります。それぞれに同じ数の列がある2つのタブがあります。タブ2のセルa1-d1が塗りつぶされたときに、セルa1-d1をタブ1に結合し、タブ2のd1の値をタブ1の新しく結合されたセルに入力するようにします。これが私が持っているものです。
1463 次
1 に答える
0
Excel VBAのメソッドと関数(Excelマクロ)の概要
セルを変更したいので、数式を使用できるとは思いません(ユーザー定義の数式でなくても)。したがって、私はあなたの問題のために優れたvbaマクロを書きました。
- FirstRows():開始点です。10行をループし、他のメソッドを呼び出します
- CheckEmptyCellValues(curRow):このメソッドは、tab2(Excelのシート2)の空のセルをチェックします。
- MergeCells(curRow)は、現在の行を数値(1から最大行数までの任意の整数)として受け取り、シート1(Excelの最初のシート)の列1から4までのセルをマージします。
4列10行でテストされた完全に機能するデモ
Sub FirstRows()
Sheets(1).Select
For curRow = 2 To 11
Merge = CheckEmptyCellValues(curRow)
If Merge = 4 Then
MergeCells (curRow)
cellValue = Sheets(2).Cells(curRow, 4).Value
Sheets(1).Cells(curRow, 1).Value = cellValue
End If
Next
End Sub
Sub MergeCells(curRow)
Sheets(1).Select
Range(Cells(curRow, 1), Cells(curRow, 4)).MergeCells = True
End Sub
Function CheckEmptyCellValues(curRow)
Merge = 0
Sheets(2).Select
For i = 1 To 4
If Len(Cells(curRow, i).Value) > 0 Then
Merge = Merge + 1
End If
Next
CheckEmptyCellValues = Merge
End Function
以下に結果を示します。シート2の値はシート1(2番目の画像)にコピーされています。シート1では、最初の画像(シート2)ですべてのセル(列aから列d)の場合、行のセルがマージされます(行2ではセルA2からセルD2まで(A2-D2は1つのセルになります))行に値がありました。
変更されたコードのバグ
modifiendコードには、不可能であるか、誤った理解につながる可能性のあることがいくつかあります。
Function CheckEmptyCellValues(curColumn)
Merge = 0
Sheets(2).Select
For i = A To d
If Len(Cells(curColumn, 11).Value) > 0 Then
Merge = Merge + 1
End If
Next
CheckEmptyCellValues = Merge
End Function
- 回線
For i = A To d
は使用できません。ループを使用する場合は、数字を使用する必要があります。これにより、1から始まる4回までのFor i = 1 To 4
コードが繰り返されます。For
Next
- この行
Cells(curColumn, 11).Value
は技術的には正しいですが、誤解を招く可能性があります。Excelは、行インデックスに後の最初の値を使用し(
、列インデックスに2番目の値を使用します。両方の値は数値である必要があります:Cells(4,2).Valueは4番目からのセル値を返します。行と2番目の列(Excel GUIのセルB4)
この行For i = A To d
をこれに変更してみFor i = 1 To 4
て、希望する結果が返されるかどうかを確認してください。
バグパート2
他の変更では、同じバグがいくつかあります。
- ループ
For curColumn = A to d
には文字ではなく数字が必要です(Aとdが数字で埋められた変数でない限り、コードサンプルによるとそうではありません) cellValue = Sheets(2).Cells(curColumn, d).Value
dが文字dでありd = 4
、ループで使用できないようなものではない場合、この行にも同じバグがあります。
これはあなたのコメントからのコードです:
Sub FirstRows()
Sheets(1).Select
For curColumn = A To d
Merge = CheckEmptyCellValues(curColumn)
If Merge = d Then
MergeCells(curColumn)
cellValue = Sheets(2).Cells(curColumn, d).Value
Sheets(1).Cells(curColumn, d).Value = cellValue
End If
Next
End
Sub Sub MergeCells(curColumn)
Sheets(1).Select
Range(Cells(curColumn, 1), Cells(curColumn, d)).MergeCells = True
End Sub
動作していないことに注意してください。
于 2012-10-27T21:43:18.517 に答える