Question

好吧，我已经使用最新的代码更新了我的代码，这些代码是工程师最慷慨帮助我的。我非常感谢你提供的所有帮助，你不知道。但是，它仍在调试.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

Answer 1

您将需要扩展更新部分的概念，可能需要移动代码，但这将搜索第二个工作簿列A的ECN，如果存在，它将创建指向电子表格的超链接，否则它将创建一个带有指向电子表格的超链接的新行。

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

固定下标超出范围。收藏品很奇怪，并且开头的索引是一个明显恶劣的VBA，让事情变得混乱。

Answer 2

此代码将检查Sheet1上的ECN并在Sheet2（数据库表）中查找它。如果在那里，它将使用Sheet1中的info值更新第二列。否则，它会在最后添加它。这可能是一个“蛮力”，在漫长的工作簿中可能会很慢。

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

编辑：格式化

用于搜索订单项是否已存在的宏，如果已存在，则更新它，如果不存在，则创建新行？

2 个答案: