Question

EXCEL VBA 数据对比错误： Range(Cells(f, 1) & Cells(f, 6)).Select

Dim x ' 表的返回行号
Dim y ' 表的返回行号
Sheets("公司现行基药").Select
x = Sheets("公司现行基药").Cells(6500, 1).End(xlUp).Row
Cells(1, 22) = "共有" & x & "条数据"

Sheets("平台基药库存").Select
y = Sheets("平台基药库存").Cells(6500, 1).End(xlUp).Row
Cells(1, 22) = "共有" & y & "条数据"

'公司进行内循环 对比 平台
'------------------------------------------------------------------
For f = 2 To y ' 平台
For i = 2 To x '公司
' 判断三种情况： 负数， 整数
o = Sheets("公司现行基药").Cells(6500, 10).End(xlUp).Row
' 4 和 1 ，平台信息 4和公司信息7， 9和6
If Sheets("公司现行基药").Cells(i, 1) = Sheets("平台基药库存").Cells(f, 1) And Sheets("公司现行基药").Cells(i, 6) = Sheets("平台基药库存").Cells(f, 6) Then
' 判断2种情况： 负数， 整数
Sheets("平台基药库存").Select
' Rows(f).
Range(Cells(f, 1) & Cells(f, 6)).Select

Selection.Copy

Sheets("公司现行基药").Select
o = o + 1
Sheets("公司现行基药").Cells(o, 10).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
' 无对应信息的数据 如何处理
Next i
Next f
并不是单纯的比较，A表和B表的内容中数量是不同的，
如果2个表有相同的则将相同的内容 A复制到 B表中相同行的第10烈
这样就实现了将2个表 相同部分的 归总，便于对比， 可是一直想到代码的编写

Answer 1

程序这么写慢死了，要循环多少次啊，你的意思是在两张表里找相同的部分，复制到一个表的空白处吧，这么写：
Sub 找相同()
Dim arr, x As Long, y As Long, d As Object, crr(), o As Long
Dim brr
o = 1
Set d = CreateObject("scripting.dictionary")
x = Sheets("公司现行基药").Cells(6500, 1).End(xlUp).Row
Sheets("公司现行基药").Cells(1, 22) = "共有" & x & "条数据"
y = Sheets("平台基药库存").Cells(6500, 1).End(xlUp).Row
Sheets("平台基药库存").Cells(1, 22) = "共有" & y & "条数据"
arr = Sheets("公司现行基药").Range("a1:i" & x)
brr = Sheets("平台基药库存").Range("a1:i" & y)
For i = 2 To x
b = arr(i, 1) & "," & arr(i, 6)
If Not d.exists(b) Then d(b) = ""
Next
For i = 2 To y
p = brr(i, 1) & "," & brr(i, 6)
If d.exists(p) Then
o = o + 1
ReDim Preserve crr(1 To 2, 2 To o)
crr(1, o) = brr(i, 1)
crr(2, o) = brr(i, 2)

End If
Next

If o > 1 Then Sheets("公司现行基药").Range("j2:k" & o) = Application.WorksheetFunction.Transpose(crr) Else MsgBox "没有相同的"
Set d = Nothing
End Sub

追问

并不是单纯的比较，A表和B表的内容中数量列的值是不同的，要实现的功能是：
如果2个表有相同的则将相同的内容
A复制到 B表中相同行的第10烈
这样就实现了 将2个表相同部分的内容归总，便于对比， 可是一直想到代码的编写

追答

那就这样，总之要转换为数组，操作单元格的时间与操作数组的时间相比，是几何级增长的。
Sub 查找相同()
Dim arr, x As Long, y As Long, d As Object
Dim brr, crr
Set d = CreateObject("scripting.dictionary")
x = Sheets("公司现行基药").Cells(6500, 1).End(xlUp).Row
ReDim crr(2 To x, 1 To 9)
Sheets("公司现行基药").Cells(1, 22) = "共有" & x & "条数据"
y = Sheets("平台基药库存").Cells(6500, 1).End(xlUp).Row
Sheets("平台基药库存").Cells(1, 22) = "共有" & y & "条数据"
arr = Sheets("公司现行基药").Range("a1:i" & x)
brr = Sheets("平台基药库存").Range("a1:i" & y)
For i = 2 To y
b = brr(i, 1) & "," & brr(i, 6)
If Not d.exists(b) Then
For j = 1 To 9
d(b) = d(b) & "@" & brr(i, j)
Next
End If
Next
For i = 2 To x
p = arr(i, 1) & "," & arr(i, 6)
If d.exists(p) Then
For j = 1 To 9
crr(i, j) = Split(d(p), "@")(j)
Next
End If
Next
Sheets("公司现行基药").Range("j2:r" & x) = crr
Set d = Nothing
End Sub
其实这个用个多条件查找的公式也很方便
=INDEX(平台基药库存!A:A,MATCH($A2&$F2,平台基药库存!$A$2:$A$6500&平台基药库存!$F$2:$F$6500,)+1)
数组公式三键结束，就是计算太慢，不过百度有好多大神喜欢用公式进行复杂运算

Answer 2

Range(Cells(f, 1) & Cells(f, 6)).Select
改成：
Range(Cells(f, 1) , Cells(f, 6)).Select

Answer 3

Range 和 Cells
可用 Range(cell1, cell2) 返回一个 Range 对象，其中 cell1 和 cell2 为指定起始和终止位置的 Range 对象.不能用连接符“&”，必须“，”分开。
Range(Cells(f, 1) & Cells(f, 6)).Select改为Range(Cells(f, 1) . Cells(f, 6)).Select

Answer 4

v

Answer 5

调试一下， F8, F9，你可以用
msgbox Cells(f, 1) & Cells(f, 6)