Question

我正在尝试创建一个在一堆xlsm工作簿上运行命令的宏。这些工作簿以数字命名（例如11.xlsm，12.xlsm，13.xlsm等），我希望宏在每个工作簿的工作表（＆＃34; 1＆＃34;）上运行一个简单的命令。该命令只包括清除单元格的内容并编写根据工作簿名称而变化的内容。

我已经给了它一个但没有成功。此外，我收到以下错误＆＃34;对象不支持此属性或方法＆＃34;。

非常感谢您的帮助。

Sub IDCell()

    Dim wbpath As String
    Dim wbnames() As String
    Dim ext As String
    Dim wbTarget As Workbook
    Dim ws As Worksheet
    Dim rgID As Range

    ext = ".xlsm"
    wbpath = "Z:\\User\Documents"
    wbnames() = Split("11,12,13", ",")  

    Dim i As Integer

    For i = 0 To UBound(wbnames)
      Set wbTarget = Workbooks.Open(wbpath & "\" & wbnames(i) & ext)

     For x = 1 To 1

      If wbTarget = "11.xslm" Then
        Set ws = Worksheets(CStr(x))
        ws.Activate
        Set rgID = ws.Range("K4:K4")
        rgID.ClearContents
        rgID.Value = "XXXX"
      End If

      If wbTarget = "12.xslm" Then
        Set ws = Worksheets(CStr(x))
        ws.Activate
        Set rgID = ws.Range("K4:K4")
        rgID.ClearContents
        rgID.Value = "YYYY"
      End If           

      If wbTarget = "13.xlsm" Then
        Set ws = Worksheets(CStr(x))
        ws.Activate
        Set rgID = ws.Range("K4:K4")
        rgID.ClearContents
        rgID.Value = "ZZZZ"
      End If

     Next    

    wbTarget.Save   
    wbTarget.Close   

   Next i

End Sub

Answer 1

您可以缩短以下内容：

For x = 1 To 1

  If wbTarget = "11.xslm" Then
    Set ws = Worksheets(CStr(x))
    ws.Activate
    Set rgID = ws.Range("K4:K4")
    rgID.ClearContents
    rgID.Value = "XXXX"
  End If

  If wbTarget = "12.xslm" Then
    Set ws = Worksheets(CStr(x))
    ws.Activate
    Set rgID = ws.Range("K4:K4")
    rgID.ClearContents
    rgID.Value = "YYYY"
  End If           

  If wbTarget = "13.xlsm" Then
    Set ws = Worksheets(CStr(x))
    ws.Activate
    Set rgID = ws.Range("K4:K4")
    rgID.ClearContents
    rgID.Value = "ZZZZ"
  End If

 Next

到

    wbTarget.Sheets("1").Range("K4").value = iif(wbnames(i)="11","XXXX",iif(wbnames(i)="12","YYYYY","ZZZZZ"))

Answer 2

你的问题是你需要wbTarget.Name而不是wbTarget，但是你可以站在你的叙述中：

避免循环x
避免使用If-Then-Else

如下：

Option Explicit

Sub IDCell()
    Dim wbPath As String, ext As String
    Dim wbNames As Variant
    Dim wbValues As Variant
    Dim i As Long

    ext = ".xlsm"
    wbpath = "Z:\\User\Documents"
    wbNames = Array(11, 12, 13) '<--| set an array of your workbook names
    wbValues = Array("XXXX", "YYYY", "ZZZZ") '<--| set an array of texta to be written in each corresponding workbook 

    For i = 0 To UBound(wbNames) '<--| loop over workbook names
        With Workbooks.Open(wbPath & "\" & wbNames(i) & ext).Worksheets("1").Range("K4") '<--| open workbook and assume as reference the range "K4" of its "1" worksheet
            .ClearContents
            .Value = wbValues(i)
        End With
        ActiveWorkbook.Close True '<--| close active workbook and save it
    Next i
End Sub

命令以带循环的文件名为条件

2 个答案: