能哪位高人給出下面的實作代碼？
uj5u.com熱心網友回復：
在線等 謝謝大家uj5u.com熱心網友回復：
我出來的效果是這樣的，但是還是和需求不一樣，請大家幫幫忙
我的代碼：
Private Sub CommandButton1_Click()
Dim i, j, CurrRow, nowCol As Integer
Dim colName, AdStr As String
CurrRow = 1
AdStr = ""
nowCol = 0
'倒著查找看需要從第幾列開始合并，KPI列不合并
For j = Sheet3.UsedRange.Columns.Count To 1 Step -1
If nowCol <> 0 Then
Exit For
End If
For i = 2 To Sheet3.UsedRange.Rows.Count
If TypeName(Sheet3.Cells(i, j).Value) = "String" Then
nowCol = j
Exit For
End If
Next
Next
For j = nowCol To 1 Step -1
CurrRow = 1
AdStr = GetColAddress(Sheet3, Sheet3.Cells(1, j))
For i = 2 To Sheet3.UsedRange.Rows.Count
If j > 1 Then
If Sheet3.Cells(i, j) = "" Then
CurrRow = i + 1
ElseIf (Sheet3.Cells(i, j) <> Sheet3.Cells(i + 1, j) Or Sheet3.Cells(i, j - 1) <> Sheet3.Cells(i + 1, j - 1)) And Sheet3.Cells(i - 1, j - 1) <> "" And Sheet3.Cells(i, j - 1) <> "" Then
Sheet3.Range(AdStr & CStr(CurrRow) + ":" + AdStr & CStr(i)).Merge
CurrRow = i + 1
End If
Else
If Sheet3.Cells(i, j) <> Sheet3.Cells(i + 1, j) Then
Sheet3.Range(AdStr & CStr(CurrRow) + ":" + AdStr & CStr(i)).Merge
CurrRow = i + 1
End If
End If
Next
Next
End Sub
'獲取報表某列的address
Function GetColAddress(sheet As Variant, colName As Variant) As String
Dim i, j As Integer
Dim AdStr As String
For j = 1 To sheet.UsedRange.Columns.Count
If sheet.Cells(1, j) = colName Then
If InStr(Mid(sheet.Cells(1, j).Address, 2, 2), "$") <> 0 Then
AdStr = Mid(sheet.Cells(1, j).Address, 2, 1)
Else
AdStr = Mid(sheet.Cells(1, j).Address, 2, 2)
End If
End If
Next
GetColAddress = AdStr
End Function
Private Sub CommandButton2_Click()
End Sub
uj5u.com熱心網友回復：
沒有大神會嗎？轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/123936.html
標籤：VBA