VBA批量导入文本文件，如何转换二维数组？

Posted 2023-04-13

导入多个带分隔符的得文本文件时生成数组后怎么对数组进行处理？求大神帮忙解决下！Sub 导入文本文件()Dim str, arr, brrWith Application.FileDialog(msoFileDialogFolderPicker)'取得用户选择的文件夹路径.AllowMultiSelect = FalseIf .Show Then p = .SelectedItems(1) Else Exit SubEnd WithIf Right(p, 1) <> "\" Then p = p & "\"f = Dir(p & "*.txt*") '开始遍历工作簿While f <> ""Filename = p & "\" & fOpen Filename For Input As #1str = StrConv(InputB(LOF(1), 1), vbUnicode)Close #1arr = Split(str, Chr(10))'只会生成一维数组，如何变成二维数组录入到单元格中Cells(Rows.Count, 1).End(3).Offset(1).Resize(UBound(arr)) = WorksheetFunction.Transpose(arr)f = DirWendEnd Sub

Sub 导入文本文件()
Dim str, arr, brr, crr, drr, i As Long
With Application.FileDialog(msoFileDialogFolderPicker) '取得用户选择的文件夹路径
.AllowMultiSelect = False
If .Show Then
p = .SelectedItems(1)
Else
Exit Sub
End If
End With
If Right(p, 1) <> "\" Then
p = p & "\"
f = Dir(p & "*.txt*") '开始遍历工作簿
While f <> ""
Filename = p & "\" & f
Open Filename For Input As #1
str = StrConv(InputB(LOF(1), 1), vbUnicode)
Close #1
arr = Split(str, Chr(10)) '只会生成一维数组，如何变成二维数组录入到单元格中
ReDim brr(UBound(arr))
For i = 0 To UBound(arr)
brr(i) = UBound(Split(arr(i), "|"))
Next i
n = Application.WorksheetFunction.Max(brr)
ReDim crr(UBound(arr), n)
For i = 0 To UBound(arr)
drr = Split(arr(i), "|")
For j = 0 To UBound(drr)
crr(i, j) = drr(j)
Next j
Next i
Cells(Rows.Count, 1).End(3).Offset(1).Resize(UBound(arr) + 1, n + 1) = crr
f = Dir
Wend
End If
End Sub 参考技术A 垂直方向叠加就好俩儿。

如何使用VBA替换批量word文件文件夹中的页脚/页眉中的文本

【中文标题】如何使用VBA替换批量word文件文件夹中的页脚/页眉中的文本

【英文标题】：How To replace text in footer/header in batch of folder of word files using VBA

【发布时间】：2022-01-11 08:24:18

【问题描述】：

我有一个关于使用 VBA 替换页脚和页眉的问题 我有一个代码，该代码可以替换一个word文件的一个文件夹中的所有文本 我从 https://www.datanumen.com/blogs/find-replace-contents-multiple-word-documents/ 这里是代码

  Sub FindAndReplaceInFolder()
  Dim objDoc As Document
  Dim strFile As String
  Dim strFolder As String
  Dim strFindText As String
  Dim strReplaceText As String
 
  '  Pop up input boxes for user to enter folder path, the finding and replacing texts.
  strFolder = InputBox("Enter folder path here:")
  strFile = Dir(strFolder & "\" & "*.docx", vbNormal)
  strFindText = InputBox("Enter finding text here:")
  strReplaceText = InputBox("Enter replacing text here:")
 
  '  Open each file in the folder to search and replace texts. Save and close the file after the action.
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=strFolder & "\" & strFile)
    With objDoc
      With Selection
        .HomeKey Unit:=wdStory
        With Selection.Find
          .text = strFindText
          .Replacement.text = strReplaceText
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
      End With
      objDoc.Save
      objDoc.Close
      strFile = Dir()
    End With
  Wend
End Sub

我的问题是如何专门为页脚/页眉替换？ 因为这段代码只能替换word文件正文中的一段文字

【问题讨论】：

SO 不是代码编写服务。你需要自己去尝试。 ***.com/help/how-to-ask 另见：wordmvp.com/FAQs/MacrosVBA/BatchFR.htm 页眉和页脚与正文不同。 gregmaxey.com/word_tip_pages/process_batch_folder_addin.htmlgmayor.com/document_batch_processes.htm

好的，谢谢您的建议，先生

参见，例如：msofficeforums.com/word/…

【参考方案1】：

我已尝试修改代码，它可以很好地回答我的案例问题

这是我的代码

Sub FindAndReplaceInFolder()
 Dim objDoc As Document
  Dim strFile As String
  Dim strFolder As String
  Dim strFindText As String
  Dim strReplaceText As String
  Dim xSelection As Selection
  Dim xSec As Section
  Dim xHeader As HeaderFooter
  Dim xFooter As HeaderFooter
 
  '  Pop up input boxes for user to enter folder path, the finding and replacing texts.
  strFolder = InputBox("Enter folder path here:")
  strFile = Dir(strFolder & "\" & "*.docx", vbNormal)
  strFindText = InputBox("Enter finding text here:")
  strReplaceText = InputBox("Enter replacing text here:")
 
  '  Open each file in the folder to search and replace texts. Save and close the file after the action.
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=strFolder & "\" & strFile)
    With objDoc
    For Each xSec In objDoc.Sections
        For Each xHeader In xSec.Headers
            xHeader.Range.Select
            Set xSelection = objDoc.Application.Selection
            With xSelection
                .HomeKey Unit:=wdStory
                With xSelection.Find
                .Text = strFindText
                .Replacement.Text = strReplaceText
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                End With
                xSelection.Find.Execute Replace:=wdReplaceAll
            End With
        Next xHeader
        For Each xFooter In xSec.Footers
            xFooter.Range.Select
            Set xSelection = objDoc.Application.Selection
            With xSelection
                .HomeKey Unit:=wdStory
                With xSelection.Find
                .Text = strFindText
                .Replacement.Text = strReplaceText
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                End With
                xSelection.Find.Execute Replace:=wdReplaceAll
            End With
        Next xFooter
    Next xSec
    objDoc.Save
    objDoc.Close
    strFile = Dir()
    End With
  Wend
End Sub

【讨论】：

您的答案可以通过额外的支持信息得到改进。请edit 添加更多详细信息，例如引用或文档，以便其他人可以确认您的答案是正确的。你可以找到更多关于如何写好答案的信息in the help center。

无需选择页眉或页脚。 Find 方法也可从Range 对象获得。编写 VBA 代码时应避免使用Selection。