Question

我尝试 1）居中并在订单列表表中的第E列和第F列下划线，从第22行到空白行。 2）将电子表格中的增值税和总计加粗并居中。 3）生成订单清单后，在其他工作表中清除G28列。但是，它没有加下划线或集中或加粗。你能帮我看一下吗？这是我的代码如下。非常感谢

Option Explicit

Sub copy_info()
Dim i As Long, j As Long, lastRow As Long
Dim sh As Worksheet

With Sheets("Order List")
.Cells.Clear
.Range("A21") = "PART CODE"
.Range("B21") = "DESCRIPTION"
.Range("C21") = "PRICE"
.Range("D21") = "QUANTITY"
.Range("E21") = "NET AMOUNT"
.Range("F21") = "SHEET NAME"
.Range("A21:F21").Font.Bold = True
End With

j = 22

For Each sh In ActiveWorkbook.Sheets
    If sh.Name <> "Order List" And sh.Name <> "INDEX" And sh.Name <> "SELECTOR" Then
        lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
        For i = 28 To lastRow
            If sh.Range("G" & i) > 0 Then
                sh.Range("b" & i).Copy Destination:=Worksheets("Order List").Range("A" & j)
                sh.Range("e" & i & ":g" & i).Copy Destination:=Worksheets("Order List").Range("B" & j)
                Sheets("Order List").Range("E" & j) = Sheets("Order List").Range("C" & j) * Sheets("Order List").Range("D" & j)
                Sheets("Order List").Range("F" & j) = sh.Name
                Sheets("Order List").Range("B" & j + 1) = ""
                Sheets("Order List").Range("B" & j + 2) = "VAT".bold.center
                Sheets("Order List").Range("E" & j + 1) = ""
                Sheets("Order List").Range("E" & j + 2) = Application.WorksheetFunction.Sum(Columns("E:E"))
                Sheets("Order List").Range("B" & j + 3) = "TOTAL".bold.center                    Sheets("Order List").Range("E" & j + 3) = Application.WorksheetFunction.Sum(Columns("E:E"))

                j = j + 1
            End If
        Next i
    End If
Next sh
Sheets("Order List").Columns("A").AutoFit
Sheets("Order List").Columns("B").ColumnWidth = 90
Sheets("Order List").Columns("C:D").AutoFit
Sheets("Order List").Columns("E:F").AutoFit.Underline.Center

For Each sh In ActiveWorkbook.Sheets
   If sh.Name <> "Order List" And sh.Name <> "INDEX" And sh.Name <> "SELECTOR" Then
        lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
        For i = 28 To lastRow
          If sh.Range("G" & i) > 0 Then
          sh.Range("G" & i).Select
          Selection.ClearContents
    End If
   Next i
End If
Next sh

End Sub

Answer 1

这有点奇怪 - 你在顶部有Sheets("Order List").Range("B" & j + 2) = "VAT".bold.center，因此你的代码根本不应该工作，因为编译错误。一旦您尝试运行代码，VBEditor应该会向您显示它们的确切位置。

以下是一个例子：

代替：

Sheets("Order List").Range("B" & j + 2).value = "VAT"
Sheets("Order List").Range("B" & j + 2).Font.Bold = True
Sheets("Order List").Range("B" & j + 2).HorizontalAlignment = xlCenter

写：

With Sheets("Order List").Range("B" & j + 2)
    .value = "VAT"
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
End With

然后你可以进一步改进它：

import Vue from 'vue'
import Toasted from 'vue-toasted'
Vue.use(VuePreview)
Vue.use(Toasted)
Vue.toasted.register('loginError', 'Wrong Email or password!', {
  type: 'error',
  duration: 2000
})
Vue.toasted.register('noInternet', 'No Internet Connection!', {
  type: 'error',
  duration: 2000
})
Vue.toasted.register('unknownError', 'Something went wrong!', {
  type: 'error',
  duration: 2000
})

甚至可以编写一个单独的函数，只传递范围和字符串。

Answer 2

您正在尝试同时执行所有操作（第一部分的粗体和中心，底部的中心和下划线）。这在VBA中不起作用。有必要采取一个接一个的行动。

您问题的一个可能解决方案可能是：

Sub copy_info()
    Dim i As Long, j As Long, lastRow As Long
    Dim sh As Worksheet

    With Sheets("Order List")
        .Cells.Clear
        .Range("A21") = "PART CODE"
        .Range("B21") = "DESCRIPTION"
        .Range("C21") = "PRICE"
        .Range("D21") = "QUANTITY"
        .Range("E21") = "NET AMOUNT"
        .Range("F21") = "SHEET NAME"
        .Range("A21:F21").Font.Bold = True
    End With

    j = 22

    For Each sh In ActiveWorkbook.Sheets
            If sh.Name <> "Order List" And sh.Name <> "INDEX" And sh.Name <> "SELECTOR" Then
                lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
                For i = 28 To lastRow
                    If sh.Range("G" & i) > 0 Then
                        sh.Range("b" & i).Copy Destination:=Worksheets("Order List").Range("A" & j)
                        sh.Range("e" & i & ":g" & i).Copy Destination:=Worksheets("Order List").Range("B" & j)
                        Sheets("Order List").Range("E" & j) = Sheets("Order List").Range("C" & j) * Sheets("Order List").Range("D" & j)
                        Sheets("Order List").Range("F" & j) = sh.Name
                        Sheets("Order List").Range("B" & j + 1) = ""
                        Sheets("Order List").Range("B" & j + 2) = "VAT"
                        Sheets("Order List").Range("B" & j + 2).Font.Bold = True
                        Sheets("Order List").Range("B" & j + 2).HorizontalAlignment = xlCenter

                        Sheets("Order List").Range("E" & j + 1) = ""
                        Sheets("Order List").Range("E" & j + 2) = Application.WorksheetFunction.Sum(Columns("E:E"))
                        Sheets("Order List").Range("B" & j + 3) = "TOTAL"
                        **Sheets("Order List").Range("B" & j + 3).Font.Bold = True
                        Sheets("Order List").Range("B" & j + 3).HorizontalAlignment = xlCenter**

                        Sheets("Order List").Range("E" & j + 3) = Application.WorksheetFunction.Sum(Columns("E:E"))

                        j = j + 1
                    End If
                Next i
            End If
        Next sh
        Sheets("Order List").Columns("A").AutoFit
        Sheets("Order List").Columns("B").ColumnWidth = 90
        Sheets("Order List").Columns("C:D").AutoFit
        Sheets("Order List").Columns("E:F").AutoFit
        Sheets("Order List").Columns("E:F").HorizontalAlignment = xlCenter
        Sheets("Order List").Columns("E:F").Font.Underline = xlUnderlineStyleSingle

        For Each sh In ActiveWorkbook.Sheets
           If sh.Name <> "Order List" And sh.Name <> "INDEX" And sh.Name <> "SELECTOR" Then
                lastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
                For i = 28 To lastRow
                  If sh.Range("G" & i) > 0 Then
                  sh.Range("G" & i).Select
                  Selection.ClearContents
            End If
           Next i
        End If
    Next sh

End Sub

尝试粗体，集中和下划线列，并在生成订单后清除列

2 个答案: