macros来search订单项是否已经存在,如果有,更新它,如果没有,创build一个新行?

好吧,我已经用最新的代码更新了我的代码,这些代码是工程师最为慷慨地帮助我的。 我非常感谢你提供的所有帮助,你不知道。 但是,它仍在debugging.Cells(ECN_Row,I + 2)= ECNCollection.Item(I)行,我用粗体和斜体。 只是想在这里得到最新的代码,所以我没有代码在我甚至没有使用的问题。 再次感谢!

Sub Export() Dim ECN As String Dim ECNCollection As New Collection ECN = Range("K3").Value 'Save values in Order of Columns to be placed in ECNCollection.Add Range("C5").Value ECNCollection.Add Range("B4").Value ECNCollection.Add Range("E33").Value ECNCollection.Add Range("D3").Value ECNCollection.Add Range("D21").Value ECNCollection.Add Range("I21").Value 'To save with correct file name ActiveWorkbook.SaveAs Filename:= _ "C:\Users\walkerja\Documents\ECN\" & ECN & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'To open ECN List find_or_create_ECN ECN, ECNCollection, "C:\Users\walkerja\Documents\ECN\ECN 2014.xls", "C:\Users\walkerja\Documents\ECN\" & ECN & ".xlsm" Set ECNCollection = Nothing End Sub Sub find_or_create_ECN(ECN As String, ECNCollection As Collection, wb_path As String, ecn_file_path As String) Dim WB As Excel.Workbook Dim LCell As Range Dim L_Row As Long Dim ECN_Found As Boolean Dim ECN_Row As Long Dim I As Integer Set WB = Workbooks.Open(wb_path) With WB.Worksheets("CONTENTS") L_Row = .Cells(.Rows.Count, "A").End(xlUp).Row For Each LCell In .Range("$A$2", "$A$" & L_Row) If UCase(Trim(LCell.Value)) = UCase(Trim(ECN)) Then ECN_Found = True ECN_Row = LCell.Row Exit For End If Next LCell If Not (ECN_Found) Then ECN_Row = L_Row + 1 End If .Hyperlinks.Add .Cells(ECN_Row, 1), ecn_file_path, TextToDisplay:=ECN For I = 0 To ECNCollection.Count - 1 ***.Cells(ECN_Row, I + 2) = ECNCollection.Item(I)*** Next I End With WB.Save WB.Close Set WB = Nothing End Sub 

一个概念,你将不得不扩大更新部分,可能需要移动代码,但这将searchECN的第二个工作簿列A,如果它会创build一个超链接到电子表格,否则将创build一个新的行指向电子表格的超链接。

 Sub Export() 'To save with correct file name Dim ECN As String Dim ECNCollection As New Collection ECN = Range("K3").Value 'Save values in Order of Columns to be placed in ECNCollection.Add Range("C5").Value ECNCollection.Add Range("B4").Value ECNCollection.Add Range("E33").Value ECNCollection.Add Range("D3").Value ECNCollection.Add Range("D21").Value ECNCollection.Add Range("I21").Value ActiveWorkbook.SaveAs Filename:="Q:\PDFLINK\ECN\2014\" & ECN & ", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False" 'To open ECN List find_or_create_ECN ECN, ECNCollection,"Q:\PDFLINK\ECN\2014\ECN 2014.xls","Q:\PDFLINK\ECN\2014\" & ECN & ".xlsm" Set ECNCollection = Nothing End Sub Sub find_or_create_ECN(ECN As String, ECNCollection As Collection, wb_path As String, ecn_file_path AS String) Dim wb As Excel.Workbook Dim lcell AS Range Dim l_row AS Long Dim ecn_found As Boolean Dim ecn_row As Long Dim i As Integer Set wb = Workbooks.Open(wb_path) With wb.Worksheets("CONTENTS") l_row = .Cells(.Rows.Count, "A").End(xlUp).Row For Each lcell in .Range("$A$2", "$A$" & l_row) If UCase(Trim(lcell.Value)) = UCase(Trim(ECN)) Then ecn_found = True ecn_row = lcell.row Exit For End If Next lcell If Not(ecn_found) Then ecn_row = l_row + 1 End If .Hyperlinks.Add .Cells(ecn_row, 1), ecn_file_path, TextToDisplay:=ECN For i = 1 to ECNCollection.Count .Cells(ecn_row,i + 1) = ECNCollection.Item(i) Next i End With wb.Save wb.Close Set wb = Nothing End Sub 

编辑

添加一个集合对象来传递值,然后循环通过该对象将值放置在i + 2列即i = 1然后第2列i = 2然后第3列等

EDIT2

固定下标超出范围。 收集是奇怪的,并开始索引1显然万岁VBA使事情混乱。

此代码将检查Sheet1上的ECN并在Sheet2(数据库表)中查找它。 如果在那里,它将用来自Sheet1的信息值更新第二列。 否则,它会在最后加上它。 这可能有点“蛮力”,而且在一本冗长的工作簿中可能会很慢。

 Sub Update() ECN = Sheets("Sheet1").Cells(3, 11) info = Sheets("Sheet1").Cells(3, 12) Sheets("Sheet2").Activate n = 1 Do If Cells(n, 1) = ECN Then Cells(n, 2) = Sheets("Sheet1").Cells(3, 12) Exit Sub End If n = n + 1 Loop Until IsEmpty(Cells(n, 1)) Cells(n, 1) = ECN Cells(n, 2) = info End Sub 

编辑:格式