按出库类别把数据写入不同的数组中

maalique

按出入库类型把相应的数据写入不同数据中。刚学VBA，写了几个都不行。
比如，我先写了个销售出库的，代码如下：
Sub test2()
    Dim arr, arr2(), rwcount As Long, colcount As Integer, rowsale As Long, tgtcount As Integer, j As Long
    Dim shtdlv As Worksheet, x As Integer

    Set shtdlv = Worksheets("delivery")

    arr = shtdlv.UsedRange.Value

    For rwcount = 2 To UBound(arr)
        If arr(rwcount, 5) = "销售出库" Then
            tgtcount = tgtcount + 1
            ReDim Preserve arr2(1 To UBound(arr, 2), 1 To tgtcount)
            For x = 1 To UBound(arr, 2)
                arr2(x, tgtcount) = arr(rwcount, x)
            Next
        End If
    Next
    Set shtdlv = Nothing
End Sub



请大侠帮忙指点

abc123281

数据量不小    想要实现   需要使用字典  或sql    但不知道你想实现什么样的效果

abc123281

你的原表格已经损坏或者是从系统导出的数据   原数据重新放在一个表中
代码仅供测试参考
两种方法随选    字典和sql  

呵呵  代码已写好 不知什么原因   可惜附件无法上传

maalique

abc123281 发表于 2018-9-5 22:25
数据量不小    想要实现   需要使用字典  或sql    但不知道你想实现什么样的效果

就是想把不同类型的出库分别放入不同的数组中，以便在后续的调用。

lsdongjh

1. Sub Test()
   
2.     Dim arr As Variant
   
3.     'arr = GetDataByType("delivery", "%")' 全部数据
   
4.     arr = GetDataByType("delivery", "销售出库") '销售出库
   
5. End Sub
   
6. 
   
7. Function GetDataByType(strShName As String, strType As String) As Variant
   
8.     Dim Conn As Object, Rst As Object, strPath As String
   
9.     Dim strConn As String, strSQL As String
   
10.     Dim arr As Variant
    
11.    
    
12.     Set Conn = CreateObject("ADODB.Connection")
    
13.     Set Rst = CreateObject("ADODB.Recordset")
    
14.     strPath = ThisWorkbook.FullName
    
15.     Select Case Application.Version * 1
    
16.         Case Is <= 11
    
17.             strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & strPath
    
18.         Case Is >= 12
    
19.             strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
20.     End Select
    
21.     Conn.Open strConn
    
22.    
    
23.     strSQL = "SELECT * " & _
    
24.               "FROM [" & strShName & "$] " & _
    
25.               "WHERE [出库类型] Like '" & strType & "'"
    
26.     Rst.Open strSQL, Conn, 3, 1
    
27.    
    
28.     If Rst.RecordCount > 0 Then
    
29.         arr = Rst.getrows
    
30.     Else
    
31.         ReDim arr(1 To 1, 1 To 1)
    
32.         arr(1, 1) = "无记录"
    
33.     End If
    
34.     Rst.Close:    Set Rst = Nothing
    
35.     Conn.Close: Set Conn = Nothing
    
36.     GetDataByType = arr
    
37. End Function
    

复制代码

abc123281

仅供参考


发货管理2018a123.rar (1.24 MB, 下载次数: 9)

2018-9-6 10:12 上传

点击文件名下载附件

maalique

abc123281 发表于 2018-9-6 10:12
仅供参考

谢谢，收益匪浅！

maalique

lsdongjh 发表于 2018-9-6 08:54

谢谢！这个正是我想要的。不过，当我把此程序复制到一个与此表格式相似中（新表比此表多出数列），则提示出错。

lsdongjh

把新表结构 传上来看看，估计是标题有问题