主页 / coding / 问题

问题[excel](coding)

Martin Hope
Bkviegas
Asked: 2025-02-19 18:14:19 +0800 CST
  • 5

我知道有很多关于使用.select和对象 _Worksheet 的错误 1004 的问题和答案，我尽我所能遵循了每一个问题和答案，特别是从下面的两个链接，但我似乎不知道我的代码出了什么问题。

Excel VBA，从非活动工作表获取范围

如何避免在 Excel VBA 中使用 Select？

我不断收到“对象‘_Worksheet’的方法‘range’失败”错误。在我看来，我的代码中没有必要使用 .Select 或 .Activate，但到目前为止，只有使用它才能正常工作。

顺便提一下，使用时.Select，Application.ScreenUpdating = False似乎不起作用，代码运行时我的屏幕转到每张表。有什么原因吗？

Sub FormatWB()

Dim X As Long
Dim AA As Long
Dim Escopo As Worksheet
Dim Material As Worksheet
Dim PrecoMTL As Worksheet
Dim PrecoRev As Worksheet
Dim Orcamento As Worksheet

Set Escopo = ActiveWorkbook.Worksheets("Escopo")
Set Material = ActiveWorkbook.Worksheets("Material")
Set PrecoMTL = ActiveWorkbook.Worksheets("Preço Material")
Set PrecoRev = ActiveWorkbook.Worksheets("Preço Revestimento")
Set Orcamento = ActiveWorkbook.Worksheets("Orçamento Final")

Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
    X = 4 'Initial Row

        Do Until IsEmpty(Escopo.Cells(X, "B"))
        

            'Escopo.Select
            
            With Escopo.Range(Cells(X, "A"), Cells(X, "Y"))
                .UnMerge
                .Borders.LineStyle = xlContinuous
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .NumberFormat = "@" 'Convert cell to text format
                .Font.Bold = False
                .Font.Italic = False
                .Font.Underline = False
                .Font.Name = "Calibri"
                .Font.Size = 11
                .Interior.ColorIndex = 0
                .Font.Color = vbBlack
            End With                                                    

            'Material.Select
            
            With Material.Range(Cells(X, "A"), Cells(X, "N"))
                .UnMerge
                .Borders.LineStyle = xlContinuous
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .NumberFormat = "@" 'Convert cell to text format
                .Font.Bold = False
                .Font.Italic = False
                .Font.Underline = False
                .Font.Name = "Calibri"
                .Font.Size = 11
                .Interior.ColorIndex = 0
                .Font.Color = vbBlack
            End With


            'PrecoMTL.Select
            
            With PrecoMTL.Range(Cells(X, "A"), Cells(X, "P"))
                .UnMerge
                .Borders.LineStyle = xlContinuous
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .NumberFormat = "@" 'Convert cell to text format
                .Font.Bold = False
                .Font.Italic = False
                .Font.Underline = False
                .Font.Name = "Calibri"
                .Font.Size = 11
                .Interior.ColorIndex = 0
                .Font.Color = vbBlack
            End With


            'PrecoRev.Select
            
            With PrecoRev.Range(Cells(X, "A"), Cells(X, "O"))
                .UnMerge
                .Borders.LineStyle = xlContinuous
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .NumberFormat = "@" 'Convert cell to text format
                .Font.Bold = False
                .Font.Italic = False
                .Font.Underline = False
                .Font.Name = "Calibri"
                .Font.Size = 11
                .Interior.ColorIndex = 0
                .Font.Color = vbBlack
            End With


            'Orcamento.Select
            
            With Orcamento.Range(Cells(X, "A"), Cells(X, "Q"))
                .UnMerge
                .Borders.LineStyle = xlContinuous
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .NumberFormat = "@" 'Convert cell to text format
                .Font.Bold = False
                .Font.Italic = False
                .Font.Underline = False
                .Font.Name = "Calibri"
                .Font.Size = 11
                .Interior.ColorIndex = 0
                .Font.Color = vbBlack
            End With
            
    X = X + 1
        Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
excel
Martin Hope
SamB
Asked: 2025-02-19 11:55:39 +0800 CST
  • 5

我在受保护的工作表中有一个 Excel 表。我正在尝试执行以下步骤：

  1. 添加一个名为“决策”的新列
  2. 解锁“决策”列内的单元格
  3. 根据另一列“已售”中的值过滤表格（如果某一行显示错误，则保持其可见并隐藏所有其他行）
  4. 对所有可见单元格应用数据验证，仅允许 2 个值“删除”或“分类”

我有以下代码。当我运行它时，我没有收到任何错误，但预期单元格中没有验证，并且单元格未解锁。另外，我认为解锁可能应该在过滤之后进行，但请考虑一下。

    Private Sub HandleErrors()

    Dim ws, wsList As Worksheet
    Dim importTable As ListObject
    Dim DecisionColumn As ListColumn
    Dim listRange, valRange, cell As Range
    Dim listOptions As String

    Set ws = Worksheets("Sales Import")
    Set importTable = ws.ListObjects("Table_SalesImport")
    Set wsList = ThisWorkbook.Worksheets("Lists")
    Set listRange = wsList.Range("A1:A2")
    Set cell = ws.Range("W2")
    listOptions = "Delete, Classify"

    ws.Unprotect Password:=PassW

    With importTable

        ws.Unprotect Password:=PassW

        Set DecisionColumn = importTable.ListColumns.Add
        DecisionColumn.Name = "Select Decision"

        Range("W2").Select
        Set valRange = Range(cell, cell.End(xlDown))
        valRange.Locked = False
        valRange.Locked = False

        If .Parent.FilterMode Then .Range.AutoFilter
 
        .Range.AutoFilter Field:=22, Criteria1:="Error"

        With valRange.Validation
            .Delete 'delete previous validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:=listOptions
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = False

        End With

        Application.Run "Protect"

    End With

    End Sub
excel
Martin Hope
flow'd
Asked: 2025-02-19 07:46:29 +0800 CST
  • 6

工作流程要求用户在使用 Excel 中的数据源时选择一个唯一 ID，然后单击一个按钮，该按钮将打开目标文件夹中的所有 pdf。我使用唯一 ID 和相关日期自动定位目标文件夹（有 10,000 个子文件夹）。我想在 Acrobat 的单个实例中打开目标目录中的所有文件。

以下可以循环遍历目标目录并打开所有 pdf 而不会出现任何错误。但这样做是在不同的 Acrobat 实例中完成的。即，如果有 5 个 pdf，则会打开 5 个 Acrobat 实例。有人可以就一种方法提供建议吗？这种方法可以在同一个 Acrobat 实例中打开目录中的所有 pdf。提前谢谢。

Sub OpenPDF1()

Dim path_to_exe As String
Dim floder_path As String
Dim pdf_to_open As String

pdf_to_open = ""

path_to_exe = "C:\\Program Files (x86)\\Adobe\\Acrobat Reader DC\\Reader\\AcroRd32.exe"

folder_path = "C:\\test1"

pdf_to_open = Dir(folder_path & "\*.pdf")

    Do While Len(pdf_to_open) > 0
        Shell path_to_exe & " " & folder_path & "\" & pdf_to_open
        pdf_to_open = Dir()
    Loop

End Sub
excel
Martin Hope
Gixman
Asked: 2025-02-18 23:43:17 +0800 CST
  • 5

我正在尝试使用以下语法打开活动工作簿位置并同时选择文件：

Shell "C:\Windows\explorer.exe /select," & location, vbMaximizedFocus

其中 location 是活动工作簿的路径

除我尝试打开的文件夹名称中包含逗号外，它都能完美运行。

例如：C:\Users\q1Bossymess\CpSolution\CpSolution - Fairgrounds\06-2025 FY\Reports, Clinical\08.25.24 AaSS.xlsx

如果我复制整个路径并将其粘贴到 Windows 资源管理器的地址栏中，它会毫无问题地打开该文件夹

当我尝试使用 Shell 语句时，问题就开始了。

如果我将目标文件夹用逗号从“Reports, Clinical”重命名为其他名称，则一切都正常。

我无法更改文件夹的名称，因为我正在构建一个插件，它将供不同计算机上的不同人使用，并且它需要在任何情况下每次都能正常工作。

谢谢。

我刚刚通过更改文件夹名称来检测问题，从而找到了问题所在。当文件夹名称中有“&”或“-”时，它可以正常工作，但当文件夹名称中有逗号时则不起作用。

我的期望是能够打开任何文件夹并在 Windows 资源管理器上突出显示活动工作簿，除了逗号问题之外，效果很好。

excel
Martin Hope
Ni Luh Sila Dewi
Asked: 2025-02-18 23:01:05 +0800 CST
  • 5

有人能帮助我解决与VBA 中的“过程太大”错误相关的问题吗？

我使用Private Sub Worksheet_Calculate()自动隐藏和取消隐藏行，我想为触发器设置 275 个单元格。下面的示例仅显示了 10 个触发器单元格，我想创建 275 个触发器单元格

代码片段

`Private Sub Worksheet_Calculate()

    Set iCell = Range("G38")
    Set iCell2 = Range("G70")
    Set iCell3 = Range("G102")
    Set iCell4 = Range("G134")
    Set iCell5 = Range("G166")
    Set iCell6 = Range("G198")
    Set iCell7 = Range("G230")
    Set iCell8 = Range("G262")
    Set iCell9 = Range("G294")
    Set iCell10 = Range("G326")

    Application.EnableEvents = False

      byFALSE1Hidden = Rows("38:68").Hidden
    byTRUE1Hidden = Rows("10000:10000").Hidden

    ' New logic for trigger 2
    byFALSE2Hidden = Rows("70:100").Hidden
    byTRUE2Hidden = Rows("10001:10001").Hidden

    ' New logic for trigger 3
    byFALSE3Hidden = Rows("102:132").Hidden
    byTRUE3Hidden = Rows("10002:10002").Hidden

    ' New logic for trigger 4
    byFALSE4Hidden = Rows("134:164").Hidden
    byTRUE4Hidden = Rows("10003:10003").Hidden

    ' New logic for trigger 5
    byFALSE5Hidden = Rows("166:196").Hidden
    byTRUE5Hidden = Rows("10004:10004").Hidden

    ' New logic for trigger 6
    byFALSE6Hidden = Rows("198:228").Hidden
    byTRUE6Hidden = Rows("10005:10005").Hidden

    ' New logic for trigger 7
    byFALSE7Hidden = Rows("230:260").Hidden
    byTRUE7Hidden = Rows("10006:10006").Hidden

    ' New logic for trigger 8
    byFALSE8Hidden = Rows("262:292").Hidden
    byTRUE8Hidden = Rows("10007:10007").Hidden

    ' New logic for trigger 9
    byFALSE9Hidden = Rows("294:324").Hidden
    byTRUE9Hidden = Rows("10008:10008").Hidden

    ' New logic for trigger 10
    byFALSE10Hidden = Rows("326:356").Hidden
    byTRUE10Hidden = Rows("10009:10009").Hidden

    
    If iCell.value = "FALSE1" Then
        If Not byFALSE1Hidden Then
            Rows("38:68").Hidden = True
            Rows("10000:10000").Hidden = False
        End If
    ElseIf iCell.value = "TRUE1" Then
        If Not byTRUE1Hidden Then
            Rows("38:68").Hidden = False
            Rows("10000:10000").Hidden = True
         End If
    End If

'   New logic for trigger 2
    If iCell2.value = "FALSE2" Then
        If Not byFALSE2Hidden Then
            Rows("70:100").Hidden = True
            Rows("10001:10001").Hidden = False
        End If
    ElseIf iCell2.value = "TRUE2" Then
        If Not byTRUE2Hidden Then
            Rows("70:100").Hidden = False
            Rows("10001:10001").Hidden = True
         End If
    End If

'   New logic for trigger 3
    If iCell3.value = "FALSE3" Then
        If Not byFALSE3Hidden Then
            Rows("102:132").Hidden = True
            Rows("10002:10002").Hidden = False
        End If
    ElseIf iCell3.value = "TRUE3" Then
        If Not byTRUE3Hidden Then
            Rows("102:132").Hidden = False
            Rows("10002:10002").Hidden = True
         End If
    End If

'   New logic for trigger 4
    If iCell4.value = "FALSE4" Then
        If Not byFALSE4Hidden Then
            Rows("134:164").Hidden = True
            Rows("10003:10003").Hidden = False
        End If
    ElseIf iCell4.value = "TRUE4" Then
        If Not byTRUE4Hidden Then
            Rows("134:164").Hidden = False
            Rows("10003:10003").Hidden = True
         End If
    End If

'   New logic for trigger 5
    If iCell5.value = "FALSE5" Then
        If Not byFALSE5Hidden Then
            Rows("166:196").Hidden = True
            Rows("10004:10004").Hidden = False
        End If
    ElseIf iCell5.value = "TRUE5" Then
        If Not byTRUE5Hidden Then
            Rows("166:196").Hidden = False
            Rows("10004:10004").Hidden = True
         End If
    End If

'   New logic for trigger 6
    If iCell6.value = "FALSE6" Then
        If Not byFALSE6Hidden Then
            Rows("198:228").Hidden = True
            Rows("10005:10005").Hidden = False
        End If
    ElseIf iCell6.value = "TRUE6" Then
        If Not byTRUE6Hidden Then
            Rows("198:228").Hidden = False
            Rows("10005:10005").Hidden = True
         End If
    End If

'   New logic for trigger 7
    If iCell7.value = "FALSE7" Then
        If Not byFALSE7Hidden Then
            Rows("230:260").Hidden = True
            Rows("10006:10006").Hidden = False
        End If
    ElseIf iCell7.value = "TRUE7" Then
        If Not byTRUE7Hidden Then
            Rows("230:260").Hidden = False
            Rows("10006:10006").Hidden = True
         End If
    End If

'   New logic for trigger 8
    If iCell8.value = "FALSE8" Then
        If Not byFALSE8Hidden Then
            Rows("262:292").Hidden = True
            Rows("10007:10007").Hidden = False
        End If
    ElseIf iCell8.value = "TRUE8" Then
        If Not byTRUE8Hidden Then
            Rows("262:292").Hidden = False
            Rows("10007:10007").Hidden = True
         End If
    End If

'   New logic for trigger 9
    If iCell9.value = "FALSE9" Then
        If Not byFALSE9Hidden Then
            Rows("294:324").Hidden = True
            Rows("10008:10008").Hidden = False
        End If
    ElseIf iCell9.value = "TRUE9" Then
        If Not byTRUE9Hidden Then
            Rows("294:324").Hidden = False
            Rows("10008:10008").Hidden = True
         End If
    End If

'   New logic for trigger 10
    If iCell10.value = "FALSE10" Then
        If Not byFALSE10Hidden Then
            Rows("326:356").Hidden = True
            Rows("10009:10009").Hidden = False
        End If
    ElseIf iCell10.value = "TRUE10" Then
        If Not byTRUE10Hidden Then
            Rows("326:356").Hidden = False
            Rows("10009:10009").Hidden = True
         End If
    End If


    Application.EnableEvents = True

End Sub

谢谢。

excel
Martin Hope
Anders Nilsson
Asked: 2025-02-18 17:53:56 +0800 CST
  • 5

似乎调用以数组为参数的函数时，如果未使用返回值，则不会更新数组（通过引用调用）。这是一个错误还是我遗漏了什么？下面是一个简短的测试宏，其生成的输出如下：

Sub Makro1()
'
' Makro1 Makro
'
' Kortkommando: Ctrl+t
'
    Dim xyzArray() As Double
    ReDim xyzArray(1 To 3)
    xyzArray(1) = 1
    xyzArray(2) = 2
    xyzArray(3) = 3
    
    Range("D2:F2").Value = xyzArray
    
    TestFunction (xyzArray)
    Range("D3:F3").Value = xyzArray
    
    newXYZ = TestFunction(xyzArray)
    Range("D4:F4").Value = xyzArray
    
    TestSub xyzArray
    Range("D5:F5").Value = xyzArray
    
    TestFunction (xyzArray)
    Range("D6:F6").Value = xyzArray

    TestFunctionNoReturn (xyzArray)
    Range("D7:F7").Value = xyzArray
  
End Sub

Private Function TestFunction(XYZ) As Double()
    XYZ(1) = XYZ(1) + 1
    XYZ(2) = XYZ(2) + 1
    XYZ(3) = XYZ(3) + 1
    TestFunction = XYZ
End Function

Private Sub TestSub(XYZ)
    XYZ(1) = XYZ(1) + 1
    XYZ(2) = XYZ(2) + 1
    XYZ(3) = XYZ(3) + 1
End Sub

Private Function TestFunctionNoReturn(XYZ) As Double()
    XYZ(1) = XYZ(1) + 1
    XYZ(2) = XYZ(2) + 1
    XYZ(3) = XYZ(3) + 1
End Function

[输出]在此处输入图片描述

excel
Martin Hope
Gerardo Arciniegas
Asked: 2025-02-15 07:49:12 +0800 CST
  • 4

由于表单的设置方式，每次用户填写表单时，不同的季度信息都会存储在一行中。出于数据分析目的和简单起见，我想“转置和合并”具有相同信息的列。在本例中，所有列都包含**季度**信息和**值**信息。

我有下表：

交易 第一季度 第二季度 第三季度 第一季度价值 第二季度价值 第三季度价值
一个 第二季度 第三季度 无效的 100美元 200美元 无效的
乙 问题 1 第二季度 第三季度 50美元 30美元 40美元

我想要转置“季度”列及其各自的值并输出以下内容：

交易 四分之一 价值
一个 第二季度 100美元
一个 第三季度 100美元
一个 无效的 无效的
乙 问题 1 50美元
乙 第二季度 30美元
乙 第三季度 40美元

我尝试过转置列但结果却变得混乱且多行。

excel
Martin Hope
Srikanth
Asked: 2025-02-14 20:58:06 +0800 CST
  • 7

我有特定的行和列数据。我需要逐一转换所有列。

图片1

=LET(a,A2:A11,cn,COUNTA(B2:D2),_a,TEXTSPLIT(REPT(TEXTJOIN(",",,a)&"$",cn),,{",","$"},1),_a)

我尝试了多种方法来获取其他列（ID，Region，WC），如下图所示，但都没有成功。

非常感谢您的帮助。

谢谢。

excel
Martin Hope
Caleb Phelps
Asked: 2025-02-14 08:21:09 +0800 CST
  • 5

我想添加一个工作表，使用表格的前 2 个单元格作为其名称。例如，在下表中，按钮 1 将创建一个名为“Doe,John”的工作表。

最后的 第一的 按钮
多伊 约翰 按钮1
多伊 简 按钮2

该按钮的代码目前如下所示，弹出一个输入框，手动输入名称，打开它，然后按字母顺序对工作表进行排序。如果工作表已经存在，它只会打开该工作表：

Sub TestSheetCreate()
    Dim newSheetName As String
    Dim checkSheetName As String
    Dim I As Integer
    Dim J As Integer
    
    newSheetName = Application.InputBox("Input Sheet Name:", "Excel 10 Tutorial", "", , , , , 2)

    On Error Resume Next

    checkSheetName = Worksheets(newSheetName).Name

    If checkSheetName = "" Then
        Worksheets.Add.Name = newSheetName
    Else
        Sheets(checkSheetName).Select
    End If

    For I = 1 To Sheets.Count - 1
        For J = I + 1 To Sheets.Count
            If UCase(Sheets(I).Name) > UCase(Sheets(J).Name) Then
                Sheets(J).Move Before:=Sheets(I)
            End If
        Next J
    Next I
    
End Sub

我该如何用按钮所在行的前两个单元格自动生成的名称替换输入框？

excel