将单元格内容拆开分别放入两个单元格

brianlong

我在写多条件多列的汇总，做到后面脑子短路了，汇总后不知道怎么把内容拆开了哪位大神帮忙完善一下

gdw831001

=SUMPRODUCT(($F2=$A$2:$A$10&"/"&$B$2:$B$10)*C$2:C$10)

lsc900707

字典+数组可以轻松完成的：

1. Sub gj23w98()
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
5.     For i = 1 To UBound(arr)
   
6.         s = arr(i, 1) & arr(i, 2)
   
7.         If d(s) = "" Then
   
8.             m = m + 1: d(s) = m
   
9.             For j = 1 To UBound(arr, 2)
   
10.                 brr(m, j) = arr(i, j)
    
11.             Next
    
12.         Else
    
13.             For j = 3 To UBound(arr, 2)
    
14.                 brr(d(s), j) = brr(d(s), j) + arr(i, j)
    
15.             Next
    
16.         End If
    
17.     Next
    
18.     [g1].Resize(m, UBound(brr, 2)) = brr
    
19. End Sub
    

复制代码

lsdongjh

1. Function 多列多条件汇总2()
   
2.     Dim lngRows As Long
   
3.     Dim Conn As Object, Rst As Object, strPath As String
   
4.     Dim strConn As String, strSQL As String
   
5.     Dim rg As Range
   
6. 
   
7.     lngRows = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
   
8.     Set rg = Sheet1.Range("G2")
   
9. 
   
10.     Set Conn = CreateObject("ADODB.Connection")
    
11.     Set Rst = CreateObject("ADODB.Recordset")
    
12.     strPath = ThisWorkbook.FullName
    
13.     Select Case Application.Version * 1
    
14.         Case Is <= 11
    
15.             strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & strPath
    
16.         Case Is >= 12
    
17.             strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
18.     End Select
    
19. 
    
20.     Conn.Open strConn
    
21. 
    
22.     '''''''''''''''''''''''''''''''''
    
23.     strSQL = "SELECT 单据编号,物料长代码,SUM(申请数) AS 申请合计,SUM(实发数) AS 实发合计  " & _
    
24.               "FROM [生产领料序时簿$A1:D" & lngRows & "] " & _
    
25.               "Group By 单据编号,物料长代码 "
    
26. 
    
27.     Rst.Open strSQL, Conn, 3, 1
    
28. 
    
29.     Sheet1.Range("G:J").ClearContents
    
30.     Sheet1.Range("G1:J1") = Array("单据编号", "物料长代码", "申请数", "实发数")
    
31. 
    
32.     rg.CopyFromRecordset Rst
    
33. 
    
34.     Set Rst = Nothing
    
35.     Set Conn = Nothing
    
36. End Function

复制代码

brianlong

lsc900707 发表于 2018-7-9 11:58
字典+数组可以轻松完成的：

如果单纯的把我的代码写完应该怎么写呢

melville

t = d1.keys
For i = 0 To UBound(t)
Cells(2 + i, 7).Resize(1, 2) = Split(t(i), "/")
Next

在原来的代码后面加上上面这几句也可以。