多条件取值求助

天边2021 · 发表于 2023-4-27 20:34

本帖最后由天边2021 于 2023-4-27 20:36 编辑

说明如图所示，请大家帮忙看看，物料代码类别多选的书写格式为：A/B A/B/F

ykcbf1100 · 发表于 2023-4-27 20:50

先做个记号。

Yalishanda30 · 发表于 2023-4-27 20:51

ykcbf1100 发表于 2023-4-27 20:50
先做个记号。

难得大神晚上也逛论坛

ykcbf1100 · 发表于 2023-4-27 21:02

Yalishanda30 发表于 2023-4-27 20:51
难得大神晚上也逛论坛

以后会多起来了。

ykcbf1100 · 发表于 2023-4-27 21:07

Yalishanda30 发表于 2023-4-27 20:51
难得大神晚上也逛论坛

刚看到你一个回复帖子，写的代码挺好的。

Yalishanda30 · 发表于 2023-4-27 21:13

ykcbf1100 发表于 2023-4-27 21:07
刚看到你一个回复帖子，写的代码挺好的。

不敢当，写着玩的

1121228509 · 发表于 2023-4-28 01:50

不知道是不是这样，很乱。

Option Explicit
Sub 查询入库单号()
Dim Arr As Variant, Brr As Variant
Dim fk As Long, hh As Long, js As Long
fk = Sheets("总表").Cells(Rows.Count, 1).End(xlUp).Row + 1
Arr = Sheets("总表").Range("A1").Resize(fk, 1)
fk = Sheets("分表").Cells(Rows.Count, 1).End(xlUp).Row - 3
Brr = Sheets("分表").Range("A4").Resize(fk, 13)
ReDim Crr(1 To fk, 1 To 11) As Variant
For hh = 1 To fk
If Not IsNumeric(Application.Match(Brr(hh, 1), Arr, 0)) Then
      js = js + 1
      Crr(js, 1) = Brr(hh, 1)
      Crr(js, 2) = Brr(hh, 2)
      Crr(js, 3) = Brr(hh, 4)
      Crr(js, 4) = Brr(hh, 10)
      Crr(js, 5) = Brr(hh, 11)
      Crr(js, 6) = Brr(hh, 13)
      Crr(js, 7) = Brr(hh, 5)
      Crr(js, 8) = Brr(hh, 6)
      Crr(js, 10) = Brr(hh, 7) '单位
      Crr(js, 11) = Brr(hh, 8)
End If
Next hh
If js > 0 Then
Sheets("总表").Cells(fk, 1).Resize(js, 11) = Crr
fk = Sheets("总表").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("总表").Sort.SortFields.Clear
'Sheets("总表").Range("A1").Resize(fk, 11).Sort key1:=Sheets("总表").Range("A1"), order1:=xlAscending, Header:=xlYes '以入库单号排序升序
Sheets("总表").Range("A1").Resize(fk, 11).Sort key1:=Sheets("总表").Range("B1"), order1:=xlAscending, Header:=xlYes '以入库日期排序升序
End If
End Sub

4.27.rar (43.14 KB, 下载次数: 1)

1121228509 · 发表于 2023-4-28 01:57

'先前上面发的少了一行代码
Option Explicit
Sub 查询入库单号()
Dim Arr As Variant, Brr As Variant
Dim fk As Long, hh As Long, js As Long
fk = Sheets("总表").Cells(Rows.Count, 1).End(xlUp).Row
Arr = Sheets("总表").Range("A1").Resize(fk, 1)
fk = Sheets("分表").Cells(Rows.Count, 1).End(xlUp).Row - 3
Brr = Sheets("分表").Range("A4").Resize(fk, 13)
ReDim Crr(1 To fk, 1 To 11) As Variant
For hh = 1 To fk
If Not IsNumeric(Application.Match(Brr(hh, 1), Arr, 0)) Then
      js = js + 1
      Crr(js, 1) = Brr(hh, 1)
      Crr(js, 2) = Brr(hh, 2)
      Crr(js, 3) = Brr(hh, 4)
      Crr(js, 4) = Brr(hh, 10)
      Crr(js, 5) = Brr(hh, 11)
      Crr(js, 6) = Brr(hh, 13)
      Crr(js, 7) = Brr(hh, 5)
      Crr(js, 8) = Brr(hh, 6)
      Crr(js, 10) = Brr(hh, 7) '单位
      Crr(js, 11) = Brr(hh, 8)
End If
Next hh
If js > 0 Then
fk = Sheets("总表").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("总表").Cells(fk, 1).Resize(js, 11) = Crr
fk = Sheets("总表").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("总表").Sort.SortFields.Clear
'Sheets("总表").Range("A1").Resize(fk, 11).Sort key1:=Sheets("总表").Range("A1"), order1:=xlAscending, Header:=xlYes '以入库单号排序升序
Sheets("总表").Range("A1").Resize(fk, 11).Sort key1:=Sheets("总表").Range("B1"), order1:=xlAscending, Header:=xlYes '以入库日期排序升序
End If
End Sub

4.27.rar (43.14 KB, 下载次数: 3)

ykcbf1100 · 发表于 2023-4-28 09:16

8楼的代码应该不是楼主想要的结果，没有考虑多选的问题。
这个题，总的来说比较复杂，首先有4个条件，每个条件中又可以不选，也可以单选，还可以多选，所以，要考虑的因素很多，需要的代码也很多。

山海风云轩 · 发表于 2023-4-28 09:22

做个记号，哈哈哈

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

[求助] 多条件取值求助

评分

评分

评分