Question

VBA的新功能和我自己的学习。下面代码的目的是从工作簿中的每个工作表中复制单元格“D5”，然后将所有数据粘贴到工作簿“数据”中，范围D4：D300（范围相当宽，因此它将比复制的单元格具有更多可用单元格）。问题是下面的代码不起作用。所有代码正在做的是在指示的范围内从第一张纸上复制单元格D5（D4：D300）。基本上复制相同的值266次。任何帮助都非常感谢。如果有更优雅/有效的方式来编写此代码，请提供建议。

play.api.http.HttpErrorHandlerExceptions$$anon$1: Execution exception[[SerializationException: java.lang.ClassNotFoundException: org.slf4j.impl.Log4jLoggerAdapter]]
    at play.api.http.HttpErrorHandlerExceptions$.throwableToUsefulException(HttpErrorHandler.scala:293)
    at play.api.http.DefaultHttpErrorHandler.onServerError(HttpErrorHandler.scala:220)
    at play.api.GlobalSettings$class.onError(GlobalSettings.scala:160)
    at play.api.DefaultGlobal$.onError(GlobalSettings.scala:188)
    at play.api.http.GlobalSettingsHttpErrorHandler.onServerError(HttpErrorHandler.scala:100)
    at play.core.server.netty.PlayRequestHandler$$anonfun$2$$anonfun$apply$1.applyOrElse(PlayRequestHandler.scala:100)
    at play.core.server.netty.PlayRequestHandler$$anonfun$2$$anonfun$apply$1.applyOrElse(PlayRequestHandler.scala:99)
    at scala.concurrent.Future$$anonfun$recoverWith$1.apply(Future.scala:346)
    at scala.concurrent.Future$$anonfun$recoverWith$1.apply(Future.scala:345)
    at scala.concurrent.impl.CallbackRunnable.run(Promise.scala:32)
Caused by: org.apache.commons.lang.SerializationException: java.lang.ClassNotFoundException: org.slf4j.impl.Log4jLoggerAdapter
    at org.apache.commons.lang.SerializationUtils.deserialize(SerializationUtils.java:166)
    at org.apache.commons.lang.SerializationUtils.deserialize(SerializationUtils.java:193)
    at edu.illinois.cs.cogcomp.core.utilities.SerializationHelper.deserializeTextAnnotationFromBytes(SerializationHelper.java:124)
    at edu.illinois.cs.cogcomp.pipeline.server.ServerClientAnnotator.annotate(ServerClientAnnotator.java:114)
    at org.allenai.ari.solvers.textilp.solvers.TextILPSolver.solve(TextILPSolver.scala:195)
    at controllers.SolveQuestion$$anonfun$solve$1.apply(SolveQuestion.scala:134)
    at controllers.SolveQuestion$$anonfun$solve$1.apply(SolveQuestion.scala:89)
    at play.api.mvc.ActionBuilder$$anonfun$apply$13.apply(Action.scala:371)
    at play.api.mvc.ActionBuilder$$anonfun$apply$13.apply(Action.scala:370)
    at play.api.mvc.Action$.invokeBlock(Action.scala:498)
Caused by: java.lang.ClassNotFoundException: org.slf4j.impl.Log4jLoggerAdapter

Answer 1

您无需指定结束范围 - 只需“计算”工作表数量即可确定您需要添加到data标签的总值数。还会在检查中添加以查看您是否在Data工作表上，因此您不会将D5值从Data再次复制到同一工作表中的一行。

Sub copycell()

    Dim sh As Worksheet
    Dim wb As Workbook
    Dim DestSh As Worksheet
    Dim i As Integer

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ThisWorkbook
    Set DestSh = wb.Sheets("Data")

    ' Loop through worksheets that start with the name "20"
    i = 4
    For Each sh In ActiveWorkbook.Worksheets
    If sh.Name = "Data" Then Exit Sub
        sh.Range("D5").Copy
        With DestSh.Range("d" & i)
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
    i = i + 1

    Next

End Sub

Answer 2

在每次通过ActiveWorkbook.Worksheets循环时，粘贴到D列中最后一个单元格下方的单元格中，除非D4为空白，在这种情况下粘贴在D4中。我假设在运行宏之前D列完全是空白但如果D3中包含某些内容，则可以取消.Range("D4") = ""测试。

Sub copycell()
Dim sh As Worksheet
Dim wb As Workbook
Dim DestSh As Worksheet
Dim LastRow As Long

    On Error GoTo GracefulExit:
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ThisWorkbook
    Set DestSh = wb.Sheets("Data")
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> "Data" Then
            sh.Range("D5").Copy
            ' Paste copied range into "Data" worksheet in Column D
            ' starting at D4
            With DestSh
                If .Range("D4") = "" Then
                    With .Range("D4")
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                    End With
                Else
                    With .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                    End With
                End If
            End With
        End If
        Application.CutCopyMode = False
    Next
GracefulExit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    If Err <> 0 Then
        MsgBox "An unexpected error no. " & Err & ": " _
        & Err.Description & " occured!", vbExclamation
    End If
End Sub

Answer 3

如果您更关注价值观，那么更简洁的代码可能如下：

Option Explicit

Sub copycell()
    Dim sh As Worksheet
    Dim iSh As Long

    With ThisWorkbook
        ReDim dataArr(1 To .Worksheets.Count - 1)
        For Each sh In .Worksheets
            If sh.Name <> "Data" Then
                iSh = iSh + 1
                dataArr(iSh) = sh.Range("D5").Value
            End If
        Next
        .Worksheets("Data").Range("D4").Resize(.Worksheets.Count - 1).Value = Application.Transpose(dataArr)
    End With
End Sub

首先将所有工作表D5单元格值存储到数组中，然后将它们一次性写入Data工作表

VBA：从所有工作表复制单元格并粘贴到列中

3 个答案: