Microsoft VBA Excel VBA学习笔记——双重筛选+复制数值1.0

问题场景

Country Product CLASS 1 CLASS 2 CLASS 3 CLASS 4 CLASS 5 CLASS 6 ...
US Apple 0.364141603 0.891821061 0.059145199 0.732011029 0.050963656 0.222464259 ...
US Banana 0.230083333 0.402726218 0.154883667 0.298890486 0.780232621 0.028592635 ...
CN Apple 0.776237047 0.507554832 0.481978786 0.964094710 0.635608483 0.650148065 ...
CN Banana 0.314416117 0.865829827 0.838746225 0.584803658 0.632143938 0.635900146 ...
HK Apple 0.038955013 0.537686547 0.396884228 0.646283709 0.980316357 0.729927410 ...
HK Banana 0.929699567 0.875914643 0.855651289 0.349502863 0.778827116 0.056140485 ...
US Orange 0.637295510 0.966399457 0.102005751 0.345379154 0.182812383 0.255992180 ...
US Strawberry 0.937893889 0.151947906 0.234707740 0.626308424 0.804376439 0.138557531 ...
CN Orange 0.589701555 0.029821538 0.324999202 0.138480401 0.410818109 0.181386365 ...
CN Strawberry 0.587089886 0.870334801 0.050660711 0.712157225 0.946011122 0.286730440 ...
HK Orange 0.884634243 0.896100687 0.675844393 0.355247262 0.498187742 0.325255134 ...
HK Strawberry 0.697344394 0.423227932 0.650203362 0.560784327 0.298141331 0.186946272 ...

简述:

其实很简单的操作,就是两次筛选后复制Item1全部数据到Item2中,两个Item有且只有一行。

草稿1

  1. 打开工作表:通过工作表名称来定位和激活工作表。
  2. 定位筛选判断列:在第一行中找到Product的列,然后进行筛选。
  3. 筛选指定名称:首先筛选出包含 name1 "Apple"和name2"Banana"的行。
  4. **再次筛选Country **:在筛选出的结果中,基于Country (US、HK、CN)进行进一步筛选并复制数据。
vba 复制代码
Function FilterAndCopyData(sheetName As String, columnName As String, name1 As String, name2 As String)
    Dim ws As Worksheet
    Dim filterColumn As Long
    Dim lastRow As Long
    Dim i As Long
    
    ' 尝试访问工作表
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(sheetName)
    On Error GoTo 0
    
    If ws Is Nothing Then
        MsgBox "工作表 '" & sheetName & "' 不存在。", vbExclamation
        Exit Function
    End If
    
    ' 找到筛选判断列
    filterColumn = 0
    For i = 1 To ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        If ws.Cells(1, i).Value = columnName Then
            filterColumn = i
            Exit For
        End If
    Next i
    
    If filterColumn = 0 Then
        MsgBox "列 '" & columnName & "' 没有找到。", vbExclamation
        Exit Function
    End If
    
    ' 清除现有筛选
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    ' 应用筛选
    ws.Range("A1").AutoFilter Field:=filterColumn, Criteria1:=name1
    ws.Range("A1").AutoFilter Field:=filterColumn, Criteria2:=name2
    
    ' 复制数据
    lastRow = ws.Cells(ws.Rows.Count, filterColumn).End(xlUp).Row
    For i = 2 To lastRow
        If ws.AutoFilter.Range.Rows(i).Hidden = False Then
            If ws.Cells(i, filterColumn).Value = name1 Then
                ' 找到产地并复制数据
                Select Case ws.Cells(i, "A").Value
                    Case "US", "HK", "CN"
                        ' 复制C列以后的数据到Banana对应行
                        ws.Cells(i, "C").Resize(1, ws.Columns.Count - 3).Copy
                        For j = 2 To lastRow
                            If ws.Cells(j, filterColumn).Value = name2 And ws.Cells(j, "A").Value = ws.Cells(i, "A").Value Then
                                ws.Cells(j, "C").PasteSpecial Paste:=xlPasteValues
                            End If
                        Next j
                End Select
            End If
        End If
    Next i
    
    ' 关闭筛选
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    MsgBox "数据复制完成。"
End Function

草稿2

  1. 接受工作表名称、列名称、以及两个筛选值作为参数。
  2. 在指定的工作表上执行筛选操作。
  3. 对筛选后的数据,按国家分类,将指定类别(Apple)的数值复制到另一个类别(Banana)中。
vba 复制代码
Sub CopyValuesBasedOnClassAndCountry(wsName As String, columnName As String, value1 As String, value2 As String)
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim countryCol As Integer, classCol As Integer, col As Integer
    Dim dataRange As Range, cell As Range
    Dim country As String
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 设置工作表
    Set ws = ThisWorkbook.Worksheets(wsName)
    
    ' 确定总行数
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 查找国家和分类列的索引
    For i = 1 To ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        If ws.Cells(1, i).Value = "Country" Then
            countryCol = i
        ElseIf ws.Cells(1, i).Value = columnName Then
            classCol = i
        End If
    Next i
    
    ' 遍历所有行
    For i = 2 To lastRow
        If (ws.Cells(i, classCol).Value = value1 Or ws.Cells(i, classCol).Value = value2) Then
            country = ws.Cells(i, countryCol).Value
            If Not dict.Exists(country) Then
                Set dict(country) = New Collection
            End If
            dict(country).Add i
        End If
    Next i
    
    ' 复制数值
    For Each key In dict.Keys
        Dim appleRow As Long
        Dim bananaRow As Long
        For Each idx In dict(key)
            If ws.Cells(idx, classCol).Value = "Apple" Then appleRow = idx
            If ws.Cells(idx, classCol).Value = "Banana" Then bananaRow = idx
        Next
        For col = 3 To ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            ws.Cells(bananaRow, col).Value = ws.Cells(appleRow, col).Value
        Next col
    Next
    
    MsgBox "数据已经根据指定的规则复制完成。"
End Sub

总结

寻找最佳的方案中》》》

相关推荐
刘_sy7 小时前
使用EasyExcel和多线程实现高效数据导出
java·excel·easyexcel·批量导出excel
PowerBI学谦12 小时前
Copilot:Excel中的Python高级分析来了
python·excel·copilot
努力的小好15 小时前
【Python 打造高效文件分类工具】
开发语言·python·microsoft
来自于狂人1 天前
解决 `pip install open-webui` 时的编译错误:Microsoft Visual C++ 14.0 或更高版本缺失
c++·microsoft·pip
yuanpan1 天前
C#中的动态类型用法总结带演示代码
windows·microsoft·c#
m0_748251721 天前
【论文投稿】Python 网络爬虫:探秘网页数据抓取的奇妙世界
爬虫·python·microsoft
E-iceblue2 天前
Python 合并 Excel 单元格
python·excel·合并
sszdzq2 天前
Excel 合并列数据
excel
CoderIsArt2 天前
微软的基本类库BCL
windows·microsoft
prince_zxill2 天前
Excel中不用复杂公式根据指定X列的数值N复制整行数据N行简单方法
excel