Skip to content
On this page

用于解决excel庞大数据比对 使用Visual Basic语言 记录下来 用于参考

涉及的一些操作:

  1. 当所在单元格是合并单元格时 向上判断 取得合并单元格中的值(合并单元格的值存储在第一个单元格中)
  2. 操作多个工作簿
  3. 获取以及设置单元格的值
vb
Sub 按钮4_Click()
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim sheetL As Excel.Worksheet
    Dim sheetR As Excel.Worksheet
    
    '声明一个字符串'
    Dim name As String
    Dim identity As String
    Dim depart As String
    Dim module As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim flag As Boolean
    Dim arr() As String
    Dim dRow As Integer
    Dim dTemp As String
    
    Set xlApp = New Excel.Application
    Set xlBook = xlApp.Workbooks.Open("C:\Users\atman\Desktop\昇兴股份ERP优化升级项目_矩阵清单_20230714.xlsx")
    Set sheetL = xlBook.Worksheets(1) '左边矩阵'
    Set sheetR = xlBook.Worksheets(4) '右边的新增表'
    
    sheetL.Activate
    
    j = 4 '从第4行开始  控制的右表'
    For i = 2 To 410
        '判断是否不为空'
        flag = sheetL.Cells(i, 8).Value <> ""
        
        If flag Then
            name = sheetL.Cells(i, 8).Value
            If Len(name) > 1 Then    '取长度大于1的'
                arr = VBA.Split(name, delimiter:="", compare:=vbTextCompare) '字符串切分'
                identity = sheetL.Cells(i, 9).Value	'获取所属身份(业务代表、关键用户)'
                depart = sheetL.Cells(i, 10).Value	'获取部门'
                If depart = "" Then	'因为部门可能是合并单元格  当前行的值可能是空 所以向上遍历'
                    dRow = i
                    Do While dRow > 1
                        '如果是合并单元格  且  当前行索引不等于当前所属合并单元格的头部索引'
                        '那就继续向上遍历找到合并单元格的第一行'
                        If sheetL.Cells(dRow, 10).MergeCells = True And dRow = sheetL.Cells(dRow, 10).MergeArea.Row Then
                            depart = sheetL.Cells(dRow, 10).Value	'找到了就获取值'
                            dRow = -1
                        Else
                            dRow = dRow - 1
                        End If
                    Loop
                End If
                
                For k = LBound(arr) To UBound(arr)
                    'sheetR.Cells(j, 26).Value = arr(k)'
                    Cells(j, 26).Value = arr(k) '姓名'
                    Cells(j, 27).Value = identity   '项目成员'
                    Cells(j, 28).Value = depart '所属基地'
                    j = j + 1
                Next k
            End If
        End If
        
        
    Next i
    
End Sub