映射列标题时键入不匹配错误

时间:2014-01-16 06:07:42

标签: excel vba excel-vba

我已尝试使用此代码来映射列标题,它可以正常运行。问题是它运行没有错误我没有得到任何输出。任何人请帮我修复它..谢谢提前< / p>

Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim tmp1, tmp2, tmp3
Dim HeadersOne As Range, HeadersTwo As Range
Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook
Dim hCell As Range

    With ThisWorkbook
      tmp1 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose file #1", , False)
      If tmp1 = False Then Exit Sub
      Workbooks.Open Filename:=tmp1, ReadOnly:=True
      Set Wb1 = ActiveWorkbook
      Set Sh1 = Wb1.Sheets("Sheet1")
      tmp2 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose file #2", , False)
      If tmp2 = False Then Exit Sub
      Workbooks.Open Filename:=tmp2, ReadOnly:=True
      Set Wb2 = ActiveWorkbook
      Set Sh2 = Wb2.Sheets("Sheet1")

      tmp3 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose file #3", , False)
      If tmp3 = False Then Exit Sub
      Workbooks.Open Filename:=tmp3, ReadOnly:=True
      Set Wb3 = ActiveWorkbook
      Set Sh3 = Wb3.Sheets("Sheet3")
  End With

Set HeadersOne = Sh3.Range("A1:A" & Sh3.Range("A" & Rows.Count).End(xlUp).Row)

Application.ScreenUpdating = False

For Each hCell In HeadersOne

    SCol = GetColMatched(Sh1, hCell.Value)
    TCol = GetColMatched(Sh2, hCell.Offset(0, 1).Value)
    LRow = GetLastRowMatched(Sh1, hCell.Value)

    For Iter = 2 To LRow
        Sh2.Cells(Iter, TCol).Value = Sh1.Cells(Iter, SCol).Value
    Next Iter

Next hCell
      Wb1.Close
      Wb2.Close
      Wb3.Close
Application.ScreenUpdating = True

End Sub

Function GetLastRowMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetLastRowMatched = Sh.Cells(Rows.Count, ColIndex).End(xlUp).Row
End Function

Function GetColMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetColMatched = ColIndex
End Function

2 个答案:

答案 0 :(得分:2)

试试这个:

tmp1 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose file #1", , False)

添加逗号,,因为您没有指定参数名称 Aslo会返回String,因此无需使用set。

另一种方式是:

tmp1 = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xls*", FilterIndex:=1, Title:="Choose file #1")

在这里,您可以指定参数 再次不需要Set

答案 1 :(得分:0)

显然,这与我昨天做的代码相同。我曾希望你能够一次解释所有内容,这样就可以在一篇文章中解决。无论如何......尝试以下代码。请在下次请求更清楚,以避免多余的修复。

Sub ModdedMap()

  Dim Wbk1 As Workbook, Wbk2 As Workbook, Wbk3 As Workbook
  Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
  Dim tmp1 As String, tmp2 As String, tmp3 As String
  Dim HeadersOne As Range
  Dim hCell As Range

  'Set up all the strings involved.
  tmp1 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose file #1", , False)
  If tmp1 = "False" Then Exit Sub
  tmp2 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose file #2", , False)
  If tmp2 = "False" Then Exit Sub
  tmp3 = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", 1, "Choose file #3", , False)
  If tmp3 = "False" Then Exit Sub

  'Open all the workbooks using the previous strings.
  Set Wbk1 = Workbooks.Open(tmp1)
  Set Wbk2 = Workbooks.Open(tmp2)
  Set Wbk3 = Workbooks.Open(tmp3)

  'Set the target sheets. MODIFY ACCORDINGLY.
  Set Sh1 = Wbk1.Sheets("Sheet1")
  Set Sh2 = Wbk2.Sheets("Sheet1")
  Set Sh3 = Wbk3.Sheets("Sheet3")

  Set HeadersOne = Sh3.Range("A1:A" & Sh3.Range("A" & Rows.Count).End(xlUp).Row)

  Application.ScreenUpdating = False

  For Each hCell In HeadersOne

      SCol = GetColMatched(Sh1, hCell.Value)
      TCol = GetColMatched(Sh2, hCell.Offset(0, 1).Value)
      LRow = GetLastRowMatched(Sh1, hCell.Value)

      For Iter = 2 To LRow
          Sh2.Cells(Iter, TCol).Value = Sh1.Cells(Iter, SCol).Value
      Next Iter

  Next hCell

  Wbk1.Close
  Wbk2.Close
  Wbk3.Close

  Application.ScreenUpdating = True

End Sub

Function GetLastRowMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetLastRowMatched = Sh.Cells(Rows.Count, ColIndex).End(xlUp).Row
End Function

Function GetColMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetColMatched = ColIndex
End Function

如果这可以解决任何问题,请告诉我们。如果失败,请详细描述您的问题 详细 。显然,数据在3个单独的工作簿中分为3页。测试上面的内容,更改需要输入的部分,并在此处报告结果。

相关问题