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

总结

寻找最佳的方案中》》》

相关推荐
心疼你的一切10 分钟前
Unity开发利器:ScriptableObject的数据容器设计与内存优化原理
microsoft·unity·c#·游戏引擎
至善迎风1 小时前
将跨平台框架或游戏引擎开发的 Windows 应用上架 Microsoft Store
windows·microsoft·游戏引擎
web守墓人1 小时前
【go语言】gopls工具与LSP协议全面解析
excel
2501_930707782 小时前
使用C#代码删除 Excel 中的公式但保留数值
excel
liliangcsdn5 小时前
python如何写数据到excel示例
开发语言·python·excel
CNRio5 小时前
将word和excel快速转换为markdown格式
python·word·excel
best_scenery16 小时前
excel绘制折线图
excel·分布图
大气层煮月亮16 小时前
Oracle EBS ERP开发——报表生成Excel标准模板设计
数据库·oracle·excel
William_cl17 小时前
【C# MVC 前置】异步编程 async/await:从 “卡界面” 到 “秒响应” 的 Action 优化指南(附微软官方避坑清单)
microsoft·c#·mvc