VBA跨表取3列数据复制到另外一个工作表

liulang0808

中华美德 发表于 2019-12-6 20:37
先感谢忙中抽时间给解答，老师的VBA程序可以执行，您没有理解我的意思，是我表达不清楚：1结账数据源的日 ...

这个代码是今天运行可以替换昨天的日期
其他日期就要看具体是什么日期在结合需求处理了

中华美德

liulang0808 发表于 2019-12-6 20:47
这个代码是今天运行可以替换昨天的日期
其他日期就要看具体是什么日期在结合需求处理了

就处理当天的。比如今天2019.12.06

liulang0808

中华美德 发表于 2019-12-6 21:17
就处理当天的。比如今天2019.12.06

楼主用附件测试下有问题吗？

liulang0808

1. Sub THS导入导出()
   
2.      Application.DisplayAlerts = False
   
3.      With Workbooks.Open(Filename:=ThisWorkbook.Path & "\1结账数据源.xls", AddToMru:=True)
   
4.         .Sheets(1).Columns("A:H").Copy ThisWorkbook.Sheets(1).Columns("B:I")
   
5.         .Close
   
6.     End With
   
7.     ThisWorkbook.Activate
   
8.     Application.DisplayAlerts = True
   
9. 
   
10.     Dim arr, brr, d, i&, j%
    
11.     Set d = CreateObject("scripting.dictionary")
    
12.         str1 = "代码,名称,1部门金额(元)2019.11.29,2部门金额(元)2019.11.29,比(%)2019.11.29,结账时间2019.11.29,离开时间2019.11.30连续(天）2019.11.29"
    
13.         With CreateObject("vbscript.regexp")
    
14.             .Global = True
    
15.             .Pattern = "\d{4}\.\d{2}\.\d{2}"
    
16.             For Each mh In .Execute(str1)
    
17.                 d(mh.Value) = 1 + d(mh.Value)
    
18.             Next mh
    
19.             
    
20.         
    
21.         End With
    
22.         str1 = Replace(str1, d.keys()(1), Format(Date + 1, "yyyy.mm.dd"))
    
23.         str1 = Replace(str1, d.keys()(0), Format(Date, "yyyy.mm.dd"))
    
24.         d.RemoveAll
    
25.         w = Split(str1, ",")
    
26.     arr = Sheet1.Range("a1").CurrentRegion
    
27.     ReDim brr(1 To UBound(arr), 1 To UBound(w) + 1)
    
28.     For i = 0 To UBound(w)
    
29.         d(w(i)) = i + 1
    
30.     Next
    
31.     For j = 1 To UBound(arr, 2)
    
32.         If d.exists(arr(1, j)) Then
    
33.             n = d(arr(1, j))
    
34.             For i = 1 To UBound(arr)
    
35.                 brr(i, n) = arr(i, j)
    
36.             Next
    
37.         End If
    
38.     Next
    
39.     Sheet2.Activate
    
40.     Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    
41. End Sub
    

复制代码

重新看了下，之前的理解有误，这次看看吧

中华美德

liulang0808 发表于 2019-12-6 21:32
重新看了下，之前的理解有误，这次看看吧

1结账数据源.xls中的数据是每天都在变化的。还是不能执行2019.12.06的数据   2019.11.29是以前的数据了，现在是2019.12.06，明天2019.12.07，一直递增下去每一天都在变化，全部的难点就是在日期是动态变化

liulang0808

中华美德 发表于 2019-12-6 21:38
1结账数据源.xls中的数据是每天都在变化的。还是不能执行2019.12.06的数据   2019.11.29是以 ...

        str1 = "代码,名称,1部门金额(元)2019.11.29,2部门金额(元)2019.11.29,比(%)2019.11.29,结账时间2019.11.29,离开时间2019.11.30连续(天）2019.11.29"
        With CreateObject("vbscript.regexp")
            .Global = True
            .Pattern = "\d{4}\.\d{2}\.\d{2}"
            For Each mh In .Execute(str1)
                d(mh.Value) = 1 + d(mh.Value)
            Next mh
            
        
        End With
        str1 = Replace(str1, d.keys()(1), Format(Date + 1, "yyyy.mm.dd"))
        str1 = Replace(str1, d.keys()(0), Format(Date, "yyyy.mm.dd"))
       msgbox str1
楼主这行这段代码看看，返回的str1对应的字符串是不是已经改成今天对应的字符串了

中华美德

liulang0808 发表于 2019-12-6 22:11
str1 = "代码,名称,1部门金额(元)2019.11.29,2部门金额(元)2019.11.29,比(%)2019.11.29,结账时间 ...

对，就是每一天的日期，今天2019.12.06，明天2019.12.07，后天2019.12.08

liulang0808

中华美德 发表于 2019-12-6 22:19
对，就是每一天的日期，今天2019.12.06，明天2019.12.07，后天2019.12.08

如果27楼的代码满足需求，还需要解决什么问题吗？如果还有问题，具体还有什么问题

中华美德

liulang0808 发表于 2019-12-7 09:59
如果27楼的代码满足需求，还需要解决什么问题吗？如果还有问题，具体还有什么问题

希望老师认真看一下:1结账数据源.xls中没有2019.11.29的字段了，全部变化为含有2019.12.06的字段，你的VBA代码不应该还有2019.11.29的字符串，它的数据是每天都在变化的。还是不能执行2019.12.06的数据   2019.11.29是以前的数据了，现在是2019.12.06，明天2019.12.07，一直递增下去每一天都在变化，全部的难点就是在日期是动态变化

liulang0808

中华美德 发表于 2019-12-7 12:30
希望老师认真看一下:1结账数据源.xls中没有2019.11.29的字段了，全部变化为含有2019.12.06的字段，你的VB ...

w = Array("代码", "名称", "1部门金额(元)2019.11.29", "2部门金额(元)2019.11.29", "比(%)2019.11.29", "结账时间2019.11.29", "离开时间2019.11.30", "连续(天）2019.11.29")
这个是楼主原来的需求，就是其中日期要修改成当天的


26楼的代码是不是已经修改成当前的，然后生成w数组？ 关于str1初始赋值里的日期是哪天有关系吗？