格式化文本为粗体并插入公式以获得总和

以上是以下代码的作用。

Private Sub CommandButton1_Click() Dim ws As Worksheet Dim i As Long Dim k As Long Set ws = ActiveSheet With ws For i = 1 To 200 If Left(.Cells(i, 1).Value, 2) = "HW" Then On Error Resume Next k = .Range(.Cells(i + 1, 1), .Cells(200, 1)).Find("HW").Row On Error GoTo 0 If k <= i Then k = 200 .Cells(i, 10).Value = Len(Cells((i + 2), 1).Value) - Len(Replace(Cells((i + 2), 1).Value, ",", "")) + 1 .Cells(i, 11).Value = "SET" .Cells(i, 12).Resize(k - i).Value = .Cells(i, 1).Resize(k - i).Value .Cells((i + 1), 12).Resize(k - i).Value = .Cells((i + 1), 1).Resize(k - i).Value .Cells((i + 2), 12).Resize(k - i).Value = ws.Cells((i + 2), 1).Resize(k - i).Value .Cells((i + 3), 12).Resize(k - i).Value = "" .Cells((i + 4), 12).Resize(k - i).Value = "QTY" .Cells((i + 4), 13).Resize(k - i).Value = "TYPE" .Cells((i + 4), 15).Resize(k - i).Value = "LENGTH" .Cells((i + 4), 16).Resize(k - i).Value = "FINISH" .Cells((i + 4), 19).Resize(k - i).Value = "LIST" .Cells((i + 4), 20).Resize(k - i).Value = "NET" .Cells((i + 4), 21).Resize(k - i).Value = "MFG" .Cells((i + 4), 22).Resize(k - i).Value = "MODEL" .Cells((i + 5), 12).Resize(k - i).Value = .Cells((i + 3), 1).Resize(k - i).Value .Cells((i + 5), 13).Resize(k - i).Value = .Cells((i + 3), 2).Resize(k - i).Value .Cells((i + 5), 15).Resize(k - i).Value = .Cells((i + 3), 5).Resize(k - i).Value .Cells((i + 5), 16).Resize(k - i).Value = .Cells((i + 3), 6).Resize(k - i).Value .Cells((i + 5), 19).Resize(k - i).Value = .Cells((i + 3), 7).Resize(k - i).Value .Cells((i + 5), 20).Resize(k - i).Value = .Cells((i + 3), 8).Resize(k - i).Value .Cells((i + 5), 21).Resize(k - i).Value = .Cells((i + 3), 3).Resize(k - i).Value .Cells((i + 5), 22).Resize(k - i).Value = .Cells((i + 3), 4).Resize(k - i).Value i = k + 1 End If Next i End With End Sub 

几个问题。 首先，我不知道为什么，但是对于第二个数据输出，它缺less了门，SET和所有不同的硬件。 它看起来是在跳过它？

第二个问题是我不知道如何使用VBA代码来使我的标题（数量，types，长度，结束，列表，networking，制造，模型）粗体。 我想我会使用text.bold，但我不认为我知道如何正确地说出来。我还想在它们下面放置一个双线，包括N列，但不包括Q和R.

第三我想总结我的NET价格在NET列的末尾，但我不知道如何指定该单元格。 我也希望它的右边的单元格将网格的总和除以特定的单元格。

第四，我试着这样做，

 "DOOR: " & ws.Cells((i + 2), 1).Resize(k - i).Value 

这会触发错误，因为一个是string，另一个是整数。 我以为我可以使用CStr（），但这是行不通的。

当所有编码正确，我想它看起来像这样。

提前感谢任何帮助！

Answer 1

我会把所有的标题行移动到一个数组中。 然后，您可以调整区域大小并分配数组。

至于你的问题：

1）math，当添加行和引用不添加行的数据也有很多math。 你基本上是覆盖数据，你去。

2）格式化粗体的一种方法是Range.Font.Bold = True 。 与那边界是相似的Range.Borders(XlEdgeBottom).LineStyle = xlDouble 。

3）再次有很多的math，有时是正确的尝试和错误。

4）你不能用resize，它不喜欢它

 Private Sub CommandButton1_Click() Dim ws As Worksheet Dim i As Long Dim k As Long Set ws = ActiveSheet Dim ofst As Long Dim ttlArr() As String ttarr = Array("QTY", "TYPE", vbNullString, "LENGTH", "FINISH", vbNullString, vbNullString, "LIST", "NET", "MFG", "MODEL") ofst = 0 With ws For i = 1 To 200 If Left(.Cells(i, 1).Value, 2) = "HW" Then On Error Resume Next k = .Range(.Cells(i + 1, 1), .Cells(200, 1)).Find("HW").Row On Error GoTo 0 If k <= i Then k = .Cells(i, 1).End(xlDown).Row + 2 .Cells(i + ofst, 11).Value = "SET" .Cells(i + ofst, 12).Resize(2).Value = .Cells(i, 1).Resize(2).Value If IsNumeric(.Cells((i + 2), 1).Value) Then .Cells(i + ofst, 10).Value = Len("'" & Format(.Cells(i + 2, 1).Value, "#,##0")) - Len(Replace("'" & Format(.Cells(i + 2, 1).Value, "#,##0"), ",", "")) + 1 .Cells(i + ofst + 2, 12).Value = "Doors: " & Format(.Cells(i + 2, 1).Value, "#,##0") Else .Cells(i + ofst, 10).Value = Len(.Cells(i + 2, 1).Value) - Len(Replace(.Cells(i + 2, 1).Value, ",", "")) + 1 .Cells(i + ofst + 2, 12).Value = "Doors: " & .Cells(i + 2, 1).Value End If .Cells(i + ofst + 4, 12).Resize(, UBound(ttarr) + 1).Value = ttarr .Cells(i + ofst + 4, 12).Resize(, UBound(ttarr) + 1).Font.Bold = True .Cells(i + ofst + 4, 12).Resize(, 5).Borders(xlEdgeBottom).LineStyle = xlDouble .Cells(i + ofst + 4, 19).Resize(, 4).Borders(xlEdgeBottom).LineStyle = xlDouble ofst = ofst + 2 .Cells(i + ofst + 3, 12).Resize(k - i - 3).Value = .Cells(i + 3, 1).Resize(k - i - 3).Value .Cells(i + ofst + 3, 13).Resize(k - i - 3).Value = .Cells(i + 3, 2).Resize(k - i - 3).Value .Cells(i + ofst + 3, 15).Resize(k - i - 3).Value = .Cells(i + 3, 5).Resize(k - i - 3).Value .Cells(i + ofst + 3, 16).Resize(k - i - 3).Value = .Cells(i + 3, 6).Resize(k - i - 3).Value .Cells(i + ofst + 3, 19).Resize(k - i - 3).Value = .Cells(i + 3, 7).Resize(k - i - 3).Value .Cells(i + ofst + 3, 20).Resize(k - i - 3).Value = .Cells(i + 3, 8).Resize(k - i - 3).Value .Cells(i + ofst + 3, 21).Resize(k - i - 3).Value = .Cells(i + 3, 3).Resize(k - i - 3).Value .Cells(i + ofst + 3, 22).Resize(k - i - 3).Value = .Cells(i + 3, 4).Resize(k - i - 3).Value .Cells(i + ofst + k - i - 1, 20).Value = WorksheetFunction.Sum(.Cells(i + ofst + 3, 20).Resize(k - i - 4)) ' Change the Range("H1") to your cell with the factor .Cells(i + ofst + k - i - 1, 21).Value = .Cells(i + ofst + k - i - 1, 20).Value / .Range("H1") .Cells(i + ofst - 2, 17).Value = .Cells(i + ofst + k - i - 1, 21).Value .Cells(i + ofst - 2, 18).Value = .Cells(i + ofst + k - i - 1, 21).Value * .Cells(i + ofst - 2, 10).Value i = k - 1 End If Next i End With End Sub 

Answer 2

我相信丢失数据的问题与查找HW *的最后一次出现有关，当没有终止HW *来查找结束logging时。 没有看到一两个硬件logging作为样本，这是我能find的最好的。

 Private Sub CommandButton1_Click() Dim ws As Worksheet Dim i As Long, k As Long, hw As Long, MX As Long Set ws = ActiveSheet With ws MX = 200 'maybe MX = .cells(rows.count, 1).end(xlup).row i = .Columns(1).Find(what:="HW*", after:=.Cells(MX, 1), lookat:=xlWhole).Row k = .Columns(1).FindNext(after:=.Cells(i, 1)).Row For hw = 1 To Application.CountIf(.Columns(1), "HW*") If k <= i Then k = MX Debug.Print i & ":" & k .Cells(i, 10) = UBound(Split(.Cells(i + 2, 1).Value, Chr(44))) + 1 .Cells(i, 11).Value = "SET" .Cells(i, 12).Resize(k - i).Value = .Cells(i, 1).Resize(k - i).Value With .Cells(i + 4, 12) .Resize(1, 11) = Array("QTY", "TYPE", vbNullString, _ "LENGTH", "FINISH", vbNullString, vbNullString, _ "LIST", "NET", "MFG", "MODEL") With Union(.Cells(1, 1).Resize(1, 5), .Cells(1, 1).Resize(1, 5)) .Font.Bold = True With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 End With End With End With .Cells((i + 5), 12).Resize(k - i).Value = .Cells((i + 3), 1).Resize(k - i).Value .Cells((i + 5), 13).Resize(k - i).Value = .Cells((i + 3), 2).Resize(k - i).Value .Cells((i + 5), 15).Resize(k - i).Value = .Cells((i + 3), 5).Resize(k - i).Value .Cells((i + 5), 16).Resize(k - i).Value = .Cells((i + 3), 6).Resize(k - i).Value .Cells((i + 5), 19).Resize(k - i).Value = .Cells((i + 3), 7).Resize(k - i).Value .Cells((i + 5), 20).Resize(k - i).Value = .Cells((i + 3), 8).Resize(k - i).Value .Cells((i + 5), 21).Resize(k - i).Value = .Cells((i + 3), 3).Resize(k - i).Value .Cells((i + 5), 22).Resize(k - i).Value = .Cells((i + 3), 4).Resize(k - i).Value i = .Columns(1).FindNext(after:=.Cells(k - 1, 1)).Row k = .Columns(1).FindNext(after:=.Cells(i, 1)).Row Next hw End With End Sub 

Answer 3

 Dim ws As Worksheet Dim MyWSTarget As Worksheet Dim i As Long Dim k As Long Set ws = ActiveSheet Set MyWSTarget = Workbooks.Open("C:\MASTER_QT.xlsx").Sheets(1) Dim ofst As Long Dim ttlArr() As String ttarr = Array("QTY", "TYPE", vbNullString, "LENGTH", "FINISH", vbNullString, vbNullString, "LIST", "NET", "MFG", "MODEL") ofst = 17 With ws For i = 1 To 200 If Left(ws.Cells(i, 1).Value, 2) = "HW" Then On Error Resume Next k = ws.Range(ws.Cells(i + 1, 1), ws.Cells(200, 1)).Find("HW").Row On Error GoTo 0 If k <= i Then k = ws.Cells(i, 1).End(xlDown).Row + 2 MyWSTarget.Cells(i + ofst, 3).Value = "SET" MyWSTarget.Cells(i + ofst, 4).Resize(2).Value = ws.Cells(i, 1).Resize(2).Value If IsNumeric(MyWSTarget.Cells((i + 2), 1).Value) Then MyWSTarget.Cells(i + ofst, 2).Value = Len("'" & Format(ws.Cells(i + 2, 1).Value, "#,##0")) - Len(Replace("'" & Format(ws.Cells(i + 2, 1).Value, "#,##0"), ",", "")) + 1 MyWSTarget.Cells(i + ofst + 2, 4).Value = "Doors: " & Format(ws.Cells(i + 2, 1).Value, "#,##0") Else MyWSTarget.Cells(i + ofst + 2, 4).Value = "Doors: " & ws.Cells(i + 2, 1).Value End If MyWSTarget.Cells(i + ofst + 4, 3).Resize(, UBound(ttarr) + 1).Value = ttarr MyWSTarget.Cells(i + ofst + 4, 3).Resize(, UBound(ttarr) + 1).Font.Bold = True MyWSTarget.Cells(i + ofst + 4, 3).Resize(, 5).Borders(xlEdgeBottom).LineStyle = xlDouble MyWSTarget.Cells(i + ofst + 4, 10).Resize(, 4).Borders(xlEdgeBottom).LineStyle = xlDouble ofst = ofst + 2 MyWSTarget.Cells(i + ofst + 3, 3).Resize(k - i - 3).Value = ws.Cells(i + 3, 1).Resize(k - i - 3).Value MyWSTarget.Cells(i + ofst + 3, 4).Resize(k - i - 3).Value = ws.Cells(i + 3, 2).Resize(k - i - 3).Value MyWSTarget.Cells(i + ofst + 3, 6).Resize(k - i - 3).Value = ws.Cells(i + 3, 5).Resize(k - i - 3).Value MyWSTarget.Cells(i + ofst + 3, 7).Resize(k - i - 3).Value = ws.Cells(i + 3, 6).Resize(k - i - 3).Value MyWSTarget.Cells(i + ofst + 3, 10).Resize(k - i - 3).Value = ws.Cells(i + 3, 7).Resize(k - i - 3).Value MyWSTarget.Cells(i + ofst + 3, 11).Resize(k - i - 3).Value = ws.Cells(i + 3, 8).Resize(k - i - 3).Value MyWSTarget.Cells(i + ofst + 3, 12).Resize(k - i - 3).Value = ws.Cells(i + 3, 3).Resize(k - i - 3).Value MyWSTarget.Cells(i + ofst + 3, 13).Resize(k - i - 3).Value = ws.Cells(i + 3, 4).Resize(k - i - 3).Value MyWSTarget.Cells(i + ofst + k - i - 1, 11).Value = WorksheetFunction.Sum(MyWSTarget.Cells(i + ofst + 3, 11).Resize(k - i - 4)) ' Change the Range("H1") to your cell with the factor MyWSTarget.Cells(i + ofst + k - i - 1, 12).Value = MyWSTarget.Cells(i + ofst + k - i - 1, 11).Value / MyWSTarget.Range("L12") MyWSTarget.Cells(i + ofst - 2, 8).Value = MyWSTarget.Cells(i + ofst + k - i - 1, 12).Value MyWSTarget.Cells(i + ofst - 2, 9).Value = MyWSTarget.Cells(i + ofst + k - i - 1, 12).Value * MyWSTarget.Cells(i + ofst - 2, 2).Value i = k - 1 End If Next i 

End With End Sub