之前发过一个帖子，蒙 风吹过b 大哥启示，仍无头绪，现在我贴出自己的不完整代码，忘各位大虾帮帮忙瞅瞅，现在主要的问题是我知道了如何读取单元格的数据，但是如何让这个数据在另外一个excel表格工作簿搜索，并找到一样的单元格，然后拷贝这个单元格一行上的信息，谢谢各位大侠。。。。


Private Sub Command1_Click()
    If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then
        MsgBox "文件名不能为空！", vbCritical, "出错"
        Exit Sub
    End If
    If Dir(Text2.Text) <> "" Then
        i = MsgBox("文件存在，是否覆盖？", vbYesNo + vbQuestion, "保存")
        If i = vbYes Then
            Kill Text2.Text
        Else
            Exit Sub
        End If
    End If
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
   
    Set xl = CreateObject("Excel.Application")
    Set X2 = CreateObject("Excel.Application")
    'xl.Visible = True
    xl.Workbooks.Open Text1.Text
    X2.Workbooks.Open Text3.Text
   
   
    Set sheet1 = xl.Workbooks(1).Worksheets(1) '数据来源表
    Set wk2 = X2.Workbooks(2) '目的数据表
    tmp_s = sheet1.Range("A1")
   
    If tmp_s <> "元件分类" Then
        MsgBox "该BOM非原始PCB导出的BOM", vbCritical, "出错"
        GoTo wk
    End If
   
      fullnum = sheet1.UsedRange.Rows.Count + 1
   
    row = 2:
    Do While True
        'seq_s = sheet1.Range("C" & row)
        'If seq_s = "" Then Exit Do
        
        seq_s = sheet1.Range("C" & row)
        If seq_s = "" Then GoTo ctt
        top_s = sheet1.Range("H" & row)
        
        
ctt:    row = row + 1
        DoEvents
        Label3.Caption = "处理进度：" & ((row - 2) * 100 \ (fullnum - 2)) & "%"
    Loop
   
    End Sub
   
   
   
   
   
   
    MsgBox "处理完成", vbInformation, "完成"
    Label3.Caption = ""
    xl.Workbooks(2).SaveAs Text2.Text
wk:
    xl.Workbooks(2).Close savechanges:=False
    xl.Workbooks(1).Close savechanges:=False
    Set sheet1 = Nothing
    Set wk2 = Nothing
    Set xl = Nothing

    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True

End Sub

可以用find，得到对应的单元格，获取其行号。后面的你自己应该会了
示例如下，随便写的，你自己调试一下

Dim Rng As Range
Rng = sht2.Range("A1:A1000").Find("abc")
r_n2=Rng.row
for i=1 to n
sht1.cells(r_n1,i)=sht2.cells(r_n2,i) '复制数据
r_n1=r_n1+1
next i

我感觉你说的这个完全可以直接用Excel自身的函数 Match，index等实现。这样更方便

谢谢xiangyue0510，呵呵，我是做硬件的，所以对语言了解的不是很多，我先琢磨下，谢谢哈

Rng = sht2.Range("A1:A1000").Find("abc")这个里面的A1:A1000就是A列，1到1000范围的单元格，abc我是不是可以用我代码里的top_s替换

sht1.cells(r_n1,i)=sht2.cells(r_n2,i)这个语句是不是两个sheet之间复制，我现在物料表里是一个工作簿，而且有很多个sheet，我搜索到后，不知道是哪个sheet，这时候怎么拷贝呢？

只是一个例子，当然可以替换

只两个sheet对应的单元格之间的复制，是哪个sheet，有Sht2确定，用if判定。

谢谢，xiangyue0510，十一回家研究研究，谢谢哈

Private Sub Command1_Click()
    If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then
        MsgBox "文件名不能为空！", vbCritical, "出错"
        Exit Sub
    End If
    If Dir(Text2.Text) <> "" Then
        i = MsgBox("文件存在，是否覆盖？", vbYesNo + vbQuestion, "保存")
        If i = vbYes Then
            Kill Text2.Text
        Else
            Exit Sub
        End If
    End If
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
   
    Set xl = CreateObject("Excel.Application")
    Set X2 = CreateObject("Excel.Application")
    'xl.Visible = True
    xl.Workbooks.Open Text1.Text
    X2.Workbooks.Open Text3.Text
   
   
    Set sheet1 = xl.Workbooks(1).Worksheets(1) '数据来源表
    Set wk2 = X2.Workbooks(2) '目的数据表
    tmp_s = sheet1.Range("A1")
   
    If tmp_s <> "元件分类" Then
        MsgBox "该BOM非原始PCB导出的BOM", vbCritical, "出错"
        GoTo wk
    End If
   
      fullnum = sheet1.UsedRange.Rows.Count + 1
   
    row = 2:
    Do While True
        'seq_s = sheet1.Range("C" & row)
        'If seq_s = "" Then Exit Do
        
        seq_s = sheet1.Range("C" & row)
        If seq_s = "" Then GoTo ctt
        top_s = sheet1.Range("H" & row)
       Dim Rng As Range
        Rng = wk2.Range("H1:H & row").Find("top_s")
        r_n2 = Rng.row
        For i = 1 To n
        sheet1.Cells(r_n1, i) = wk2.Cells(r_n2, i) '复制数据
        r_n1 = r_n1 + 1
        Next i
        
ctt:    row = row + 1
        DoEvents
        Label3.Caption = "处理进度：" & ((row - 2) * 100 \ (fullnum - 2)) & "%"
    Loop
   
    End Sub
   
   
   
   
   
   
    MsgBox "处理完成", vbInformation, "完成"
    Label3.Caption = ""
    xl.Workbooks(2).SaveAs Text2.Text
wk:
    xl.Workbooks(2).Close savechanges:=False
    xl.Workbooks(1).Close savechanges:=False
    Set sheet1 = Nothing
    Set wk2 = Nothing
    Set xl = Nothing

    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True

End Sub


hi，xiangyue0510，你好，我对VB基本上不懂，也只能按照表面意思去改一些东西，我把你的推荐语句写上去了，稍微改动了下，发现有编译错误。首先我自己也有很多不明白的地方，A1:A1000是这个A列一共从A1到A1000去寻找，而我的代码里面已经有了这句，fullnum = sheet1.UsedRange.Rows.Count + 1，我理解的就是找到我这个excel表格里有多少行，根据这个我该如何改写，这个sheet1.Cells(r_n1, i) = wk2.Cells(r_n2, i)是复制数据，这个r_n1和r_n2应该也需要定义吧，这个如何定义呢？谢谢，偶对VB真的不懂，只能一点点的去猜，谢谢！

xiangyue0510，代码这个地方老是过不去，提示编译错误：未找到方法或数据成员。不知道何故，谢谢！