按条件取值

luketools

按条件取值：
如果取固定的品牌规格客户，代码会写。但是如果某个条件也是变化的，代码如何写？
例如：想取品牌A，规格10*10的产品，但只取上海和广东区域的客户的，不取其他区域客户的？
将取的值放在另外的单元格

数据比较多，客户品牌规格都是随机的，如何写代码？谢谢

醉眼看尘世

如果取固定的品牌规格客户，代码会写。

——既如此，你先写上代码。然后上传文件，大家帮着改改就行了。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

luketools

ykcbf1100 发表于 2024-10-9 18:18
附件供参考。。。

非常感谢

gwjkkkkk

Option Explicit
Sub test1()
    Dim ar, br, i&, cnn As Object, rst As Object, strCnn$, strSQL$, strPath$
   
    Set cnn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")
    strPath = ThisWorkbook.FullName
   
    Select Case Application.Version * 1
        Case Is <= 11
            strCnn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data Source=" & strPath
        Case Is >= 12
            strCnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    End Select
   
    cnn.Open strCnn
    ar = [H3].CurrentRegion.Value
    br = Split(ar(1, 2), "和")
   
    strSQL = "Select * From [sheet1$A3:E] Where (" & ar(1, 1) & " like '" & br(0) & "%' or " & ar(1, 1) & _
        " like '" & br(1) & "%') and " & ar(2, 1) & "='" & ar(2, 2) & "' and " & ar(3, 1) & "='" & ar(3, 2) & "'"
    Set rst = cnn.Execute(strSQL)

    With ThisWorkbook.Sheets(2)
        .Cells.Clear
        For i = 0 To rst.Fields.Count - 1
            .Cells(1, i + 1) = rst.Fields(i).Name
        Next i
        .Range("A2").CopyFromRecordset rst
        .Cells.EntireColumn.AutoFit
        .Activate
    End With
   
    rst.Close: cnn.Close
    Set rst = Nothing: Set cnn = Nothing
    Beep
End Sub

gwjkkkkk

参与一下。。。

Qs18

1. Sub qs()
   
2. Dim arr, i
   
3. With Sheet1
   
4.     arr = .Range("a3").CurrentRegion.Value
   
5.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
6.     s = [i3].Value: ss = [i4].Value: sss = [i5].Value
   
7.     For i = 2 To UBound(arr)
   
8.         If InStr(s, Left(arr(i, 2), 2)) Then
   
9.             If arr(i, 3) = ss Then
   
10.                 If arr(i, 4) = sss Then
    
11.                 m = m + 1
    
12.                 For j = 1 To UBound(arr, 2)
    
13.                     brr(m, j) = arr(i, j)
    
14.                 Next
    
15.                 End If
    
16.             End If
    
17.         End If
    
18.     Next
    
19.     If m Then
    
20.     .[i10].Resize(10000, 7) = ""
    
21.     .[i10].Resize(m, UBound(arr, 2)) = brr
    
22.     End If
    
23. End With
    
24. End Sub

复制代码

Qs18

试试...........

Qs18

试试...........