如何将表格中符合条件的内容复制到另一张工作表中

sunyweb · 发表于 2020-12-14 20:06

各位大侠，小弟遇到一个问题。
1、在数据表的sheet1中根据C列的数据进行条件判断，如C列当中的地址中符合“长期不发百世区域”的名称，数据自动复制到Sheet2表中。
2、内容详见附件，谢谢。

不知道有没有高手可以帮忙的，急！！！！谢谢哈！！！！！

一帆风顺2020 · 发表于 2020-12-14 21:51

本帖最后由一帆风顺2020 于 2020-12-14 22:05 编辑

需要把地址规范一下，把每个地址的关键字提取出来，然后和C列比对，只要C列出现关键字的就是符合要求的，你现在的地址太乱了

sunyweb · 发表于 2020-12-15 10:28

一帆风顺2020 发表于 2020-12-14 21:51
需要把地址规范一下，把每个地址的关键字提取出来，然后和C列比对，只要C列出现关键字的就是符合要求的，你 ...

根据您的指导，已对文件进行关键词补充，详见G列，谢谢。

half-life · 发表于 2020-12-16 13:22

Option Explicit
Sub 筛选()
Dim i As Integer, j As Integer, index As Integer, w1 As Worksheet, w2 As Worksheet
Set w1 = Worksheets("Sheet1")
Set w2 = Worksheets("Sheet2")
i = 2
Do While Trim(w1.Cells(i, 3)) <> ""
      For j = 2 To 74 Step 1
         index = InStr(w1.Cells(i, 3), w1.Cells(j, 7))
         If index > 0 Then
            w2.Cells(i, 1) = w1.Cells(i, 1)
            w2.Cells(i, 2) = w1.Cells(i, 2)
            w2.Cells(i, 3) = w1.Cells(i, 3)
            w2.Cells(i, 4) = w1.Cells(i, 4)
            w2.Cells(i, 5) = w1.Cells(i, 5)
         End If
      Next j
      i = i + 1
Loop
Sheets("Sheet2").Select
Range(Cells(1, 1), Cells(i, 5)).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
End Sub

hamletl · 发表于 2020-12-16 13:22

请看附件附件

half-life · 发表于 2020-12-16 13:22

初步解决的代码已经发上去了

half-life · 发表于 2020-12-16 13:23

你可以看看能不能解决问题

		自动登录	找回密码
密码			免费注册