|
楼主 |
发表于 2024-4-1 10:08
|
显示全部楼层
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim startCol As String
Dim endCol As String
Dim firstOneRow As Long
Dim nonOneRow As Long
Dim lastCol As Long
Dim sumRange As Range
Dim cell As Range
Dim i As Long
Dim j As Integer
' 设置工作表
Set ws = ActiveSheet
' 获取用户输入的起始列和结束列
startCol = TextBox1.Text
endCol = TextBox2.Text
' 检查输入的列是否有效
If Not IsColumnValid(startCol) Or Not IsColumnValid(endCol) Then
MsgBox "输入的列标识符无效,请确保使用正确的列标识符(例如: A, B, AA)", vbExclamation, "无效输入"
Exit Sub
End If
' 计算结束列的列号
lastCol = ColumnNumber(endCol)
' 从上往下遍历A列
For i = 1 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' 检查当前行的A列单元格是否为1
If ws.Cells(i, 1).Value = 1 Then
firstOneRow = i
nonOneRow = i + 1
' 寻找下一个值为1的行或直到表格末尾
Do Until nonOneRow > ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Or ws.Cells(nonOneRow, 1).Value <> 1
nonOneRow = nonOneRow + 1
Loop
' 如果没有找到下一个值为1的行,则默认为超出表格范围
If nonOneRow > ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Then
nonOneRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
End If
' 计算指定范围内的列和,并将结果单元格加粗
For j = ColumnNumber(startCol) To lastCol
Set sumRange = ws.Range(ws.Cells(firstOneRow, j), ws.Cells(nonOneRow - 1, j))
ws.Cells(nonOneRow, j).Formula = "=SUM(" & sumRange.Address & ")"
' 设置求和结果单元格的字体为加粗
ws.Cells(nonOneRow, j).Font.Bold = True
Next j
' 跳过已处理过的行
i = nonOneRow - 1
End If
Next i
' 清理
Set ws = Nothing
Set sumRange = Nothing
End Sub
' 辅助函数,用于将列标识符转换为列号
Function ColumnNumber(colStr As String) As Long
Dim i As Integer
Dim colNum As Long
colNum = 0
For i = 1 To Len(colStr)
colNum = colNum * 26 + (Asc(Mid(colStr, i, 1)) - 64)
Next i
ColumnNumber = colNum
End Function
' 辅助函数,用于检查列标识符是否有效
Function IsColumnValid(colStr As String) As Boolean
IsColumnValid = (Len(colStr) > 0) And (Asc(Left(colStr, 1)) >= 65 And Asc(Left(colStr, 1)) <= 90)
End Function
这是运行正常的版本,我想加一个工作簿和工作表选择需求。 |
|