Question

EXCEL VBA编写代码提取的数据？

越搞越难，还得请EXCEL VBA专家出手相助！每次EXCEL VBA专家都豪不计报酬的帮助我，真是很感动！因在解决这次数据表导入时，还有最有这个表得提取，这个表难都很大，需要提取的数据如下 ：D列的title根据Sheet4表中C列的值取“+”号左边的颜色和取“+”号右边的尺码，并且按B列的id分开自动排列出来的； C列的specid是根据Sheet4表中B列的goodsid值去匹配Sheet2表中的G列goodsid值找到对应的Sheet2表中A列的specid值（因同一个goodsid有两个specid,所以还得根据什么条件来判断，是否可以根据刚才在取“+”号左右值是作为判断依据） F列自动显示为1 G列按C列的相同id自动从0起显示序号
悬赏5个币，是因我的财富值只有7个，系统又只能让我设置5个，请见谅！





Answer 1

答：

Sub today()
    Dim Cell As Range, Cell3 As Range, IDRng As Range
    Dim Color As New Collection, Size As New Collection
    Dim i As Long, j As Long
    Dim ID As Long
    
    Set Cell = Sheets("Sheet4").Range("B2")
    Set Cell3 = Sheets("Sheet3").Range("D2")
    With Sheets("Sheet2")
        Set IDRng = .Range("G2:G" & .Cells(Rows.Count, "G").End(xlUp).Row)
    End With
    On Error Resume Next
    Do Until IsEmpty(Cell)
        If Cell <> Cell.Offset(1, 0) Then
            ID = Cell.Value
            Color.Add Split(Cell.Offset(0, 1), "+")(0), CStr(Split(Cell.Offset(0, 1), "+")(0))
            Size.Add Split(Cell.Offset(0, 1), "+")(1), CStr(Split(Cell.Offset(0, 1), "+")(1))
            For i = 1 To Color.Count
                ''依次填入不重复颜色项---[生成D列值]
                Cell3 = Color.Item(i)
                ''根据颜色项和goodsid，到Sheet2中查找specid---[生成C列值]
                For j = 1 To IDRng.Count
                    If IDRng.Cells(j, 1) = ID And IDRng.Cells(j, 1).Offset(0, -4) = "颜色" Then
                        Cell3.Offset(0, -1) = IDRng.Cells(j, 1).Offset(0, -6)
                        Exit For
                    End If
                Next
                ''---[生成F列值]
                Cell3.Offset(0, 2) = 1
                ''---[生成G列值]
                Cell3.Offset(0, 3) = i - 1
                Set Cell3 = Cell3.Offset(1, 0)
            Next
            For i = 1 To Size.Count
                Cell3 = Size.Item(i)
                For j = 1 To IDRng.Count
                    If IDRng.Cells(j, 1) = ID And IDRng.Cells(j, 1).Offset(0, -4) = "尺码" Then
                        Cell3.Offset(0, -1) = IDRng.Cells(j, 1).Offset(0, -6)
                        Exit For
                    End If
                Next
                Cell3.Offset(0, 2) = 1
                Cell3.Offset(0, 3) = i - 1
                Set Cell3 = Cell3.Offset(1, 0)
            Next
            For i = Color.Count To 1 Step -1
                Color.Remove i
            Next i
            For i = Size.Count To 1 Step -1
                Size.Remove i
            Next i
        Else
            Color.Add Split(Cell.Offset(0, 1), "+")(0), CStr(Split(Cell.Offset(0, 1), "+")(0))
            Size.Add Split(Cell.Offset(0, 1), "+")(1), CStr(Split(Cell.Offset(0, 1), "+")(1))
        End If
        Set Cell = Cell.Offset(1, 0)
    Loop
End Sub

Answer 2

1
2
3
4
5
6
7

Sub Macro1()
dim years as string
years ="2000"
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.cells.AutoFilter Field:=4, Criteria1:=years
End Sub

以上代码定于years 变量，可根据设置年份
然后选择第一行，生成高级筛选，筛选条件是第四列，筛选内容是变量years