关于读取其他文件数据并筛选的VB开发，求助

鱼羊鱼

自己做电商的，平时主要用EXCEL做做透视表，VB偶尔使用主要以模仿代码为主
现在有迫切的要求，做一个综合的分析系统，现在数据归纳遇到瓶颈，请各位高手不吝出手赐教，万分感谢！
（上传附件里有我自己尝试写的代码，模仿别人代码一点一点拆解，实在不理解做不下去了，请高手直接忽略...）
主要要求：
VB工程文件在：根目录
数据文件在： 根目录/04商品店铺榜数据/“品牌"/"品牌+货号"

数据格式

现在工程目的是，在不打开数据文件的前提下
在VB工程文件内选择"品牌"和"货号"自动提取相应的数据文件数据
在VB工程文件内选择"时间"自动展示对应时间的数据内容（筛选上步文件数据）以方便下步的数据分析
细节要求：
1.数据文件路径需用VB工程文件的相对路径，方便多人在不同电脑不同储存位置皆可正确读取数据；
2.可以使用单独的sheet页面做数据缓冲，因为后期计划分析可能需同时分析同比/环比增长，如果在不影响处理效率仅用缓存就可以达到不需缓冲更完美；
3.具体数据摆放位置：

数据文件

最终目的

数据文件会非常多，仅发两个文件夹供测试，如果可以可以考虑到读取数据的形式可以直接建立数据透视表方便更进一步分析
以下附件，VB代码请尽量多的注释，特别是特殊的命令，跪谢
文件夹.rar (515.61 KB, 下载次数: 26)

2016-5-28 16:15 上传

点击文件名下载附件
附件含数据文件

鱼羊鱼

我自己的思路是在选择 品牌 和 款式 后，把对应表数据粘贴到新的sheet表上，然后摆脱VB用公式来筛选。
应该是比较笨的方法，不知道VB里建立二维数组，然后对应值与目标值一致输出对应内容，应该会避免用sheet表来过渡，直接输出结果。
本人的VB基础实在太差，具体请大神帮忙，最重要的是能有注释能学习到整个的编程思路，十分感谢

鱼羊鱼

在线等待，求助。。。

鱼羊鱼

跪求大神帮忙~万分感谢！

skyzxh

附件下载不了。。。。。。。。。。。。。。。。。。

opiona

1.     Set SH1 = Sheets("商品店铺榜")
   
2.     SH1.Range("A13:L1048576").ClearContents
   
3.    
   
4.     Pathinstr = "" & SH1.Cells(3, 3).Value & "" & SH1.Cells(3, 2).Value & ".xls"
   
5.    
   
6.     FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
   
7.     For I = 0 To UBound(FileArr)
   
8.         If InStr(FileArr(I), Pathinstr) > 0 Then
   
9.             Str_coon = "HDR=yes';Data Source =" & FileArr(I)    '//OFFICE2003，2007 通用
   
10.             StrSQL = "SELECT 来源,UV,占比 FROM [Sheet1$] WHERE 1=1"
    
11.             StrSQL = StrSQL & " AND 类别='" & SH1.Cells(10, 1).Value & "'"
    
12.             StrSQL = StrSQL & " AND 渠道='PC'"
    
13.             If Len(SH1.Cells(3, 5).Value) > 0 Then StrSQL = StrSQL & " AND 日期=#" & Format(SH1.Cells(3, 5).Value, "yyyy-MM-dd") & "#"
    
14.             StrSQL = StrSQL & " ORDER BY UV DESC"
    
15. '            MsgBox StrSQL
    
16.             SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
    
17.             SH1.Range("A13").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR
    
18.             
    
19.             StrSQL = "SELECT 来源,UV,占比 FROM [Sheet1$] WHERE 1=1"
    
20.             StrSQL = StrSQL & " AND 类别='" & SH1.Cells(10, 1).Value & "'"
    
21.             StrSQL = StrSQL & " AND 渠道='无线'"
    
22.             If Len(SH1.Cells(3, 5).Value) > 0 Then StrSQL = StrSQL & " AND 日期=#" & Format(SH1.Cells(3, 5).Value, "yyyy-MM-dd") & "#"
    
23.             StrSQL = StrSQL & " ORDER BY UV DESC"
    
24.             SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
    
25.             SH1.Range("H13").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR
    
26.         End If
    
27.     Next I

复制代码

opiona

好像你只需要一个文件内的文件
指定文件夹内，指定文件的：符合筛选条件的数值
文件夹.rar (534.29 KB, 下载次数: 62)

2016-5-28 21:54 上传

点击文件名下载附件

Ethan-Ethan

Sub 数据()
Dim arr(), brr(), wb As Workbook
With Workbooks("04商品店铺榜V2Alpha").Worksheets("商品店铺榜")
If .Range("E3") = "" Then
    MsgBox "请输入日期"
    Exit Sub
End If
Path = ThisWorkbook.Path & "\"
str1 = "04商品店铺榜数据\" & Range("C3").Value & "\"
str2 = Range("B3").Value & ".xlsx"

Set wb = Workbooks.Open(Path & str1 & str2)
arr1 = wb.Worksheets("Sheet1").UsedRange.Value
For I = 2 To UBound(arr1, 1)
   
        If arr1(I, 1) = .Range("E3") And arr1(I, 2) = "流量来源" And arr1(I, 3) = "PC" Then
           n = n + 1
           ReDim Preserve arr(1 To 3, 1 To n)
           arr(1, n) = arr1(I, 4)
           arr(2, n) = arr1(I, 5)
           arr(3, n) = arr1(I, 6)
        ElseIf arr1(I, 1) = .Range("E3") And arr1(I, 2) = "流量来源" And arr1(I, 3) = "无线" Then
           q = q + 1
           ReDim Preserve brr(1 To 3, 1 To q)
           brr(1, q) = arr1(I, 4)
           brr(2, q) = arr1(I, 5)
           brr(3, q) = arr1(I, 6)
        End If
   
      
   
Next I
wb.Close
.Range("a13").Resize(n, 3) = WorksheetFunction.Transpose(arr)
.Range("H13").Resize(q, 3) = WorksheetFunction.Transpose(brr)
End With
MsgBox "ok"

End Sub

不知道你的同比环比怎么比，现在只能先做到基本信息了

鱼羊鱼

感谢，这就去测试

鱼羊鱼

opiona 发表于 2016-5-28 21:55
好像你只需要一个文件内的文件
指定文件夹内，指定文件的：符合筛选条件的数值

感谢大神，针对SQL语句，还有详细的注释和函数用法
研究拓展中，谢谢