美文网首页
删除重复列(多列)的VBA写法

删除重复列(多列)的VBA写法

作者: 马云生 | 来源:发表于2023-10-07 09:34 被阅读0次

Sub RemoveDuplicateRows()

        Dim selectStartCloumnCount As Integer: selectStartCloumnCount = 0

        Dim selectStartCloumn As String

        Dim selectEndCloumnCount As Integer: selectEndCloumnCount = 0

        Dim selectEndCloumn As String

        Dim selectEndCloumnNM As String

        Dim currenPoint As Integer: counter = 0

        Dim sumCount As Integer

        Dim Cols As Variant

        Dim countTo As Integer

        Dim wkSht As Worksheet

        Dim objectSheet As Boolean

        Dim wkName As String

        wkName = ThisWorkbook.Name

        For Each wkSht In Sheets

          objectSheet = wkSht.Name Like "*データ"

          If objectSheet Then

            currenPoint = 0

            selectEndCloumnCount = 0

            selectStartCloumnCount = 0

            RowCount = wkSht.Columns(2).Find("→", , , , , xlPrevious).Row

            Set FoundCells = FindAll(wkSht)

              If FoundCells Is Nothing Then

                Debug.Print "nothing is found"

              Else

                sumCount = FoundCells.Cells.Count

                For Each FoundCell In FoundCells.Cells

                    If currenPoint = 0 Then

                      selectStartCloumnCount = FoundCell.Column

                      selectStartCloumn = FoundCell.Address

                    Else

                        selectEndCloumnCount = FoundCell.Column - 1

                        selectEndCloumn = FoundCell.Address

                        selectEndCloumnNM = Num2Name(selectEndCloumnCount)

                      ReDim Cols(0 To selectEndCloumnCount - selectStartCloumnCount)

                      For I = 0 To UBound(Cols)

                        Cols(I) = I + 1

                      Next I

                      wkSht.Range(selectStartCloumn & ":" & selectEndCloumnNM & RowCount).RemoveDuplicates Columns:=(Cols), Header:=xlNo

                      selectStartCloumnCount = selectEndCloumnCount + 1

                      selectStartCloumn = selectEndCloumn

                    End If

                      currenPoint = currenPoint + 1

                      If currenPoint = sumCount Then

                        If wkName Like "*料金-請求*" Then

                          Set FoundCell = Cells(4, "AK")

                        Else

                            If wkName Like "*CRM*" Then

                              Set FoundCell = Cells(4, "AEH")

                            Else

                              Set FoundCell = Cells(4, "APR")

                            End If

                        End If

                        selectEndCloumnCount = FoundCell.Column

                        selectEndCloumnNM = Num2Name(selectEndCloumnCount)

                        ReDim Cols(0 To selectEndCloumnCount - selectStartCloumnCount)

                        For I = 0 To UBound(Cols)

                        Cols(I) = I + 1

                        Next I

                        wkSht.Range(selectStartCloumn & ":" & selectEndCloumnNM & RowCount).RemoveDuplicates Columns:=(Cols), Header:=xlNo

                    End If

                  Next FoundCell

              End If

          End If

        Next wkSht

    End Sub

    Function FindAll(sheet As Worksheet)

      Dim FoundCell As Range

      Dim FoundCells As Range

      Dim LastCell As Range

      Dim FirstAddr As String

      Dim SearchRange As Range

      Dim FindWhat As Variant

      Dim MatchCase As Boolean

      Dim LookIn As XlFindLookIn

      Dim LookAt As XlLookAt

      Dim SearchOrder As XlSearchOrder

        Set SearchRange = sheet.Range("B4").EntireRow

        FindWhat = "→"

        LookIn = xlValues

        LookAt = xlWhole

        SearchOrder = xlByRows

        MatchCase = False

      With SearchRange

        Set LastCell = .Cells(.Cells.Count)

      End With

      Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _

        LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)

      If Not FoundCell Is Nothing Then

        Set FoundCells = FoundCell

        FirstAddr = FoundCell.Address

        Do

          Set FoundCells = Application.Union(FoundCells, FoundCell)

          Set FoundCell = SearchRange.FindNext(after:=FoundCell)

        Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)

      End If

      If FoundCells Is Nothing Then

        Set FindAll = Nothing

      Else

        Set FindAll = FoundCells

      End If

    End Function

    Function Num2Name(ByVal ColumnNum As Long) As String

        On Error Resume Next

        Num2Name = ""

        Num2Name = Replace(Cells(1, ColumnNum).Address(0, 0), "1", "")

    End Function

相关文章

  • MaiaDB 查询表(六)

    第一部分 基本SELECT 1.1 检索单列 1.2 检索多列 1.3 检索所有的列 1.4 去除重复列 **DI...

  • mysql删除重复列的记录

    使用select方式 无法执行 查询可以 使用聚合方式 可以删除

  • 【UiPath 问题 04】Invoke VBA 无法执行

    Invoke VBA 的执行原理:临时性地插入 VBA 文件到工作簿,执行完毕之后再将工作簿内的 VBA 文件删除...

  • MySQL学习日记(15)列字段的增删改

    添加列字段单列,多列 需要注意的添加多列时就不能设置 FIRST|AFTER 删除列字段,多列 修改列的定义 修改列名

  • iOS二维数组的删除

    tableView中多行多列中的数据删除。

  • 将数据分割到多个工作表中

    运用 VBA 代码基于列将数据分割到多个工作表中 如果你想快速并自动的基于列分割数据,下面的 VBA 代码是不错的...

  • vba案列

    Sub 九九剩法() Dim i As Integer Dim j As Integer For i = 1 To...

  • mysql-修改数据表

    如果不加 first | after 则被添加到最后一列 指定添加在某一列后面 多列只能添加在最后 删除单列 删除...

  • Oracle表字段的增删改查

    新增删除接口 Oracle 增加修改删除字段 添加、修改、删除多列的话,用逗号隔开。 使用alter table ...

  • DDL-数据定义语言

    1、库 创建数据库 删除数据库 2、表 创建表 删除表 3、列 增加列 删除列 修改列 4、键 添加主键 删除主键...

网友评论

      本文标题:删除重复列(多列)的VBA写法

      本文链接:https://www.haomeiwen.com/subject/ugnmbdtx.html