Question

我在特定工作簿中有多个工作表，每个工作表都有员工编号。工作表已按照A列始终为员工编号的方式进行了排序。

所以我需要做的是遍历所有工作表并应用RemoveDuplicates函数删除A列中找到的所有重复的员工编号。

注意 - 我并不是要让员工编号只出现在一张纸上;我试图在每张工作表上只显示一次员工编号。

当我命名一个特定的工作表时，我有它工作，但是不能让它在循环中工作。

测试1：

Sub deleteDuplicate()

    Dim ws As Worksheet
    Dim wkbk1 As Workbook
    Dim w As Long
    Dim lRow As Long
    Dim iCntr As Long

    Set wkbk1 = Workbooks("3rd Party.xlsm")

    wkbk1.Activate

    With wkbk1

        For w = 1 To .Worksheets.count

            With Worksheets(w)

                .UsedRange.RemoveDuplicates Columns:=1, Header:=xlYes

            End With

        Next w

    End With

End Sub

的Test2：

{{1}}

Answer 1

两个测试中的问题

ThisWorkbook - 它意味着代码不在Test 1中
- ThisWorkbook 使用For Each ws In ThisWorkbook.Worksheets - 明确（Test 2）
- ThisWorkbook 使用With Worksheets(w) - 隐式（"3rd Party.xlsm"）
为此，文件ThisWorkbook必须同时打开

尝试下面的版本，如果代码未在wb中运行，请相应地更新ThisWorkbook

（Version 1是执行VBA代码的文件）

Option Explicit Public Sub DeleteDuplicates1() Dim wb As Workbook, ws As Worksheet, lr As Long, lc As Long, ur As Range On Error Resume Next 'Expected error: wb not found Set wb = ThisWorkbook 'Workbooks("3rd Party.xlsm") If Not wb Is Nothing Then Application.ScreenUpdating = False For Each ws In wb.Worksheets lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column Set ur = ws.Range("A1", ws.Cells(lr, lc)) ur.RemoveDuplicates Columns:=Array(1), Header:=xlYes Next Application.ScreenUpdating = True End If End Sub - 确定最后一行和最后一列

Version 2

Public Sub DeleteDuplicates2() Dim wb As Workbook, ws As Worksheet On Error Resume Next 'Expected error: wb not found Set wb = ThisWorkbook 'Workbooks("3rd Party.xlsm") If Not wb Is Nothing Then Application.ScreenUpdating = False For Each ws In wb.Worksheets ws.UsedRange.RemoveDuplicates Columns:=Array(1), Header:=xlYes Next Application.ScreenUpdating = True End If End Sub - UsedRange

"3rd Party.xlsm"

如果您在运行其中任何一个版本时没有任何反应，则文件"3rd Party.xlsx"不存在。
要么它当前没有打开，要么名称不同 - 也许是x（带有.UsedRange）

如果第2版仍有错误，Public Sub RemoveEmptyRowsAndColumns() Dim wb As Workbook, ws As Worksheet, lr As Long, lc As Long, er As Range, ec As Range On Error Resume Next 'Expected error: wb not found Set wb = ThisWorkbook 'Workbooks("3rd Party.xlsm") If Not wb Is Nothing Then Application.ScreenUpdating = False For Each ws In wb.Worksheets lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column If lr > 1 And lc > 1 Then Set er = ws.Range(ws.Cells(lr + 1, "A"), ws.Cells(ws.Rows.Count, "A")) Set ec = ws.Range(ws.Cells(1, lc + 1), ws.Cells(1, ws.Columns.Count)) er.EntireRow.Delete 'Shift:=xlUp ec.EntireColumn.Delete 'Shift:=xlToLeft End If Next Application.ScreenUpdating = True End If End Sub可能不符合您的预期

尝试使用此Sub

清除额外的行和列

echo '<input style="float:left; margin-left:182px; margin-top:-6px; border:0px; background:none; box-shadow:none;" type="text" id="city" name="city" readonly="readonly" value="">';
            echo '<input style="float:left; border:0px; margin-top:-6px; background:none; box-shadow:none;" type="text" id="state" name="state" readonly="readonly" value="">';
            echo '<input style="float:left; border:0px; margin-top:-6px; background:none; box-shadow:none;" type="text" id="zip" name="zip" readonly="readonly" value="">';
            echo '<input type="text" id="custAdd" name="custAdd">';


<script>
   $("custAdd").change(function(){
    document.getElementById('custAdd').value = 
    document.getElementById('city').value + ', ' + 
    document.getElementById('state').value + ' ' + 
    document.getElementById('zip').value;
 };
</script>

VBA - 删除工作簿中多个工作表的重复项

1 个答案: