Which tall person can give the implementation of the code below?

CodePudding user response:

Such as online thank you

CodePudding user response:

My result is such, but still, unlike demand, ask everybody to help




My code:


Private Sub CommandButton1_Click ()
Dim I, j, CurrRow nowCol As Integer
Dim colName, AdStr As String
CurrRow=1
AdStr=""

NowCol=0
'backwards to find the need to start from which columns to merge, KPI column that merger
For j=Sheet3 UsedRange. Columns. The Count To 1 Step - 1
If nowCol & lt;> 0 Then
The Exit For
End the If
For I=2 To Sheet3. UsedRange. Rows. Count
If TypeName (Sheet3. Cells (I, j) Value)="String" Then
NowCol=j
The Exit For
End the If
Next
Next

For j=nowCol To Step 1-1
CurrRow=1
AdStr=GetColAddress (Sheet3, Sheet3. Cells (1, j))
For I=2 To Sheet3. UsedRange. Rows. Count
If j & gt; 1 Then
If Sheet3. Cells (I, j)="" Then
CurrRow=I + 1
ElseIf (Sheet3. Cells (I, j) & lt;> Sheet3. Cells (I + 1, j) Or Sheet3. Cells (I, j - 1) & lt;> Sheet3. Cells (I + 1, j - 1)) And Sheet3. Cells (I - 1, j - 1) & lt;> "And" Sheet3. Cells (I, j - 1) & lt;> "" Then
Sheet3. Range (AdStr & amp; CStr (CurrRow) + ":" + AdStr & amp; CStr (I)). The Merge
CurrRow=I + 1
End the If
The Else
If Sheet3. Cells (I, j) & lt;> Sheet3. Cells (I + 1, j) Then
Sheet3. Range (AdStr & amp; CStr (CurrRow) + ":" + AdStr & amp; CStr (I)). The Merge
CurrRow=I + 1
End the If
End the If
Next
Next
End Sub


Get the report column address
The Function GetColAddress (sheet As the Variant, colName As the Variant) As String
Dim I, j As Integer
Dim AdStr As String

For j=1 To sheet UsedRange. Columns. The Count
If sheet. Cells (1, j)=colName Then
If InStr (mids (sheet) Cells (1, j) Address, 2, 2), "$") & lt;> 0 Then
AdStr=Mid (sheet) Cells (1, j) Address, 2, 1)
The Else
AdStr=Mid (sheet) Cells (1, j) Address, 2, 2)
End the If
End the If
Next
GetColAddress=AdStr
End the Function

Private Sub CommandButton2_Click ()

End Sub

CodePudding user response:

No great god?