excel vba按读取打开的excel文件数据并按条件写入未打开的excel文件

xuersweety · 发表于 2012-1-9 23:00

files.rar (11.59 KB, 下载次数: 80)

我有两个excel文件。
qq.xlsx中只有一个事件如NN的数据，
write.xlsx中有多个事件的数据.
在qq中创建一个宏读取其中的数据并按照时间和数据类型（F1,F2,F3）将符合条件的数据填入write文件中相应位置（write文件要求不打开）。

xuersweety · 发表于 2012-1-10 18:19

等待高手答复

zhaogang1960 · 发表于 2012-1-10 18:50

xuersweety 发表于 2012-1-10 18:19
等待高手答复

不是真正的不打开，没有判断日期是否相同：

Sub Macro1()
Dim arr, c As Range, i&, lr&, sh As Worksheet
Set sh = ActiveSheet
arr = [a1].CurrentRegion
lr = UBound(arr) - 1
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\write.xlsx")
With Worksheets(1).Range("a:a")
For i = 2 To UBound(arr, 2)
Set c = .Find(arr(1, i), , , 1)
If Not c Is Nothing Then
firstAddress = c.Address
Do
brr = sh.Cells(2, i).Resize(lr)
c.Offset(, 1).Resize(, lr) = WorksheetFunction.Transpose(brr)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next
End With
.Close True
End With
Application.ScreenUpdating = True
MsgBox "ok"
End Sub

复制代码

xuersweety · 发表于 2012-1-10 19:01

zhaogang1960 发表于 2012-1-10 18:50
不是真正的不打开，没有判断日期是否相同：

谢谢，但是我一运行，就死机了。要求不打开，我听说用ADO可以，你知道怎么做吗？
还有如果不打开，你知道怎样向未打开的那个excel文件里（也就是write）的特定单元格写入数据吗？（例如向B3中写入数据，最好是可以用cells的形式）

xuersweety · 发表于 2012-1-10 20:35

高手快来啊~~

zhaogang1960 · 发表于 2012-1-10 21:01

xuersweety 发表于 2012-1-10 19:01
谢谢，但是我一运行，就死机了。要求不打开，我听说用ADO可以，你知道怎么做吗？
还有如果不打开，你知道 ...

ADO:

Sub Macro1() '引用Microsoft ActiveX Data Objects 2.x Library
Dim cnn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL$, arr, i&, j&, lr&, s$, t$
arr = [a1].CurrentRegion
lr = UBound(arr)
t = "[Feuil1$" & [a3].Resize(60000, lr).Address(0, 0) & "]"
cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=no';data source=" & ThisWorkbook.Path & "\write.xlsx"
For j = 2 To UBound(arr, 2)
SQL = "select * from " & t & " where f1='" & arr(1, j) & " '"
Set rs = New ADODB.Recordset
rs.Open SQL, cnn, 1, 3
If rs.RecordCount Then
s = ""
For i = 2 To lr
s = s & "f" & i & "=" & arr(i, j) & " ,"
Next
SQL = "update " & t & " set " & Left(s, Len(s) - 1) & " where f1='" & arr(1, j) & " '"
cnn.Execute SQL
End If
Next
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

复制代码

xuersweety · 发表于 2012-1-10 21:17

zhaogang1960 发表于 2012-1-10 21:01
ADO:

你好，我运行了一下，一个数据都没有写入。
我又更新了一下文件。只要能将这个月的前一个月的数据写入对应位置就行。
麻烦帮我看一下好吗？
里面带宏的那个qq有我写的一个宏，但是执行不成功，并且每次运行都要弹出选择路径的出口，
等待高手解答~~

files2.rar (34.11 KB, 下载次数: 45)

zhaogang1960 · 发表于 2012-1-10 21:26

xuersweety 发表于 2012-1-10 21:17
你好，我运行了一下，一个数据都没有写入。
我又更新了一下文件。只要能将这个月的前一个月的数据写入对 ...

Sub Macro1() '引用Microsoft ActiveX Data Objects 2.x Library
Dim cnn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL$, arr, i&, j&, lr&, lc%, s$, t$
arr = [a1].CurrentRegion
lr = UBound(arr)
lc = UBound(arr, 2)
t = "[Feuil1$" & [a3].Resize(60000, lc).Address(0, 0) & "]"
cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=no';data source=" & ThisWorkbook.Path & "\write.xlsx"
For i = 3 To lr
SQL = "select * from " & t & " where f1='" & arr(i, 1) & " '"
Set rs = New ADODB.Recordset
rs.Open SQL, cnn, 1, 3
If rs.RecordCount Then
s = ""
For j = 2 To lc
s = s & "f" & j & "=" & arr(i, j) & " ,"
Next
SQL = "update " & t & " set " & Left(s, Len(s) - 1) & " where f1='" & arr(i, 1) & " '"
cnn.Execute SQL
End If
Next
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

复制代码

zhaogang1960 · 发表于 2012-1-10 21:27

原来的方法和现在的ADO都可以运行，请看演示

xuersweety · 发表于 2012-1-10 21:32

zhaogang1960 发表于 2012-1-10 21:01
ADO:

是我改了文件，我用以前的文件试了。的确写入了数据，但是不是只在NN那写入，MM那也写入了，
我需要寻找write里和qq里数据名相对应的区域，只将对应区域写入（也就是只在NN对应的单元格里写入）。
你帮我看看按照files2里的文件做，好吗？
还有，高手能不能写点注释呀，我很菜的，第一次用，
万分感谢！！！

		自动登录	找回密码
密码			免费注册

[求助] excel vba按读取打开的excel文件数据并按条件写入未打开的excel文件

评分