Question

我正在尝试删除范围中列中的重复值。例如，我有下表（是的，看起来像一个转置表）：

如何删除B1：F3范围内的重复列？所需的输出将如下：

我尝试了以下一段代码，但它无效：

ActiveSheet.Range（“$ B $ 1：$ F $ 3”）。RemoveDuplicates Columns：= Array（2,3,4,5,6），Header：= xlNo

我收到运行时错误：应用程序定义或对象定义错误。

Answer 1

您的范围内没有6列。列索引是相对的，而不是工作表中的列号。

ActiveSheet.Range("$B$1:$F$3").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
        Header:=xlNo

此外，从一开始就使用VBA，避免使用ActiveSheet。

Answer 2

你可以通过几个for循环很容易地做到这一点，例如：

' number of columns
COL = 7

' for each column
for x = 2 to (COL-1)
    ' check subsequent columns
    for y = x+1 to COL
        'if they are the same delete the second one
        if cells(1,x) = cells(1,y) and cells(2,x) = cells(2,y) and cells(3,x) = cells(3,y) then
            columns(y).delete
        end if
    next y
next x

Answer 3

以下内容将转置您的数据，然后删除重复项，然后粘贴原始数据而不重复：

Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Lastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
ws.Range("A1:F" & LastRow).Copy
ws.Range("A" & LastRow + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False
ws.Range("$A$" & LastRow + 1 & ":$C$" & (LastRow + 1 + Lastcol)).RemoveDuplicates Columns:=Array(1, 2, 3), _
        Header:=xlYes
ws.Range("$A$" & LastRow + 1 & ":$C$" & (LastRow + 1 + Lastcol)).Copy
ws.Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
ws.Range("$A$" & LastRow + 1 & ":$C$" & (LastRow + 1 + Lastcol)).ClearContents
End Sub

Answer 4

这是另一个按列删除重复项。

Option Explicit

Sub nmrewq()
    Dim i As Long

    With Worksheets("sheet13")
        With .Range("B1:F3")
            For i = .Columns.Count To 2 Step -1
                If Application.CountIfs(.Cells(1, 1).Resize(1, i), .Cells(1, i), _
                                        .Cells(2, 1).Resize(1, i), .Cells(2, i), _
                                        .Cells(3, 1).Resize(1, i), .Cells(3, i)) > 1 Then
                    .Cells(1, i).EntireColumn.Delete
                End If
            Next i
        End With
    End With
End Sub

Answer 5

另外一个答案不会造成伤害。此代码也将删除不受欢迎的列。

Sub RemoveDupCols()
    Dim rng As Range
    Dim cl As Range
    Set rng = Range("B:F")
    For Each cl In Intersect(rng, ActiveSheet.Range("1:1"))
        Do While TypeName(Range(cl.Offset(, 1), rng.Range("F1")).Find(cl.Value)) <> "Nothing"
           Debug.Print Range(cl.Offset(, 1), rng.Range("F1")).Find(cl.Value).Delete
        Loop
    Next
End Sub

Answer 6

在OP的请求后

编辑

这是我的0.02美分

$var1 = $_POST['userInput1'];
$var1 = $_POST['userInput2'];

$stmt = $db->prepare("INSERT INTO tableName (Column1, Column2) VALUES (?, ?)");
$stmt->bindParam(1, $var1);
$stmt->bindParam(2, $var2);
$stmt->execute();

它使用Option Explicit Sub main() Dim myRange As Range, cell As Range Set myRange = Range("$B$1:$F$1") With CreateObject("Scripting.Dictionary") For Each cell In myRange .Item(Join(Application.Transpose(cell.Resize(3).Value), "|")) = cell.EntireColumn.Address Next Intersect(myRange, Range(Join(.items, ","))).EntireColumn.Hidden = True End With With myRange.Resize(3) .SpecialCells(xlCellTypeVisible).Delete .EntireColumn.Hidden = False End With End Sub收集＆＃34; unique＆＃34;列标记为键，相应的列索引标记为项

然后它隐藏了＆＃34; unique＆＃34;列，删除可见（即＆＃34;重复＆＃34;）的列，最后使所有剩余（即＃34;唯一＆＃34;）列可见

按行而不是列删除范围中的重复值

6 个答案: