Question

我尝试将信息从Word中的以下格式转移到Excel列＆＃34; a＆＃34;，＆＃34; b＆＃34;，＆＃34; c＆＃34;，＆＃ 34; d＆＃34;而忽略前面的数字，这是条目的索引（在这种情况下是21）

到目前为止，这是我所得到的，但它仅适用于左上角的粗体文字，但我不知道如何获得其他子串。任何有关这方面的帮助将不胜感激。

Sub TheBoldAndTheExcelful()
  Dim docCur As Document
  Dim snt As Range
  Dim i As Integer
  'Requires a reference to the 'Microsoft Excel XX.0 Object Library'
  Dim appXL As Excel.Application, xlWB As Excel.Workbook, xlWS As Excel.Worksheet

  'This assumes excel is currently closed
  Set appXL = CreateObject("Excel.Application")
  appXL.Visible = True
  Set xlWB = appXL.Workbooks.Add
  Set xlWS = xlWB.Worksheets(1)

  On Error GoTo ErrHandler
  Application.ScreenUpdating = False

  Set docCur = ActiveDocument

  For Each snt In docCur.Sentences
    If snt.Bold = True Then
      i = i + 1
      xlWS.Cells(i, 1).Value = snt.Text
    End If
  Next snt

ExitHandler:
  Application.ScreenUpdating = True
  Set snt = Nothing
  Exit Sub

ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub

Answer 1

在您的示例中，

  For Each snt In docCur.Sentences
    If snt.Bold = True Then
      i = i + 1
      xlWS.Cells(i, 1).Value = snt.Text
    End If
  Next snt

让我们重写第一个

  For Each snt In docCur.Sentences
    If snt.Bold = True Then
      i = i + 1
      xlWS.Cells(i, COLUMN_A).Value = snt.Text
    End If
  Next snt

您只包括粗体句（If snt.Bold = True），并且只写COLUMN_A。

你想要的是粗体句和之后的三个句子，你想要写入四个列。< / p>

因此请将此部分更改为：

'  Dim j As Long ' - make sure to have already declared this, or just uncomment this line

  For j = 1 to docCur.Sentences.Count ' perhaps docCur.Paragraphs instead?
    If docCur.Sentences(j).Bold = True Then
      i = i + 1
      ' used 1+n and j+n for ease of understanding, but you can make these constant with a real solution; or you could even put this in another loop if you wanted, e.g. For n = 0 to 3, ...
      xlWS.Cells(i, 1+0).Value = docCur.Sentences(j+0).Text
      xlWS.Cells(i, 1+1).Value = docCur.Sentences(j+1).Text
      xlWS.Cells(i, 1+2).Value = docCur.Sentences(j+2).Text
      xlWS.Cells(i, 1+3).Value = docCur.Sentences(j+3).Text
    End If
  Next j

或者，为了最大限度地提高绩效：

'  Dim j As Long ' - make sure to have already declared this, or just uncomment this line

  With docCur.Sentences ' perhaps docCur.Paragraphs instead?
    For j = 1 To .Count
      If .Item(j).Bold = True Then
        i = i + 1
        xlWS.Cells(i, 1).Resize(, 4).Value = Array(.Item(j + 0).Text, .Item(j + 1).Text, .Item(j + 2).Text, .Item(j + 3).Text)
      End If
    Next j
  End With

根据评论，更改：

问题：＆＃34;还有一些句子，我在第二行有一点点，所以从技术上讲，自格式化以来总共会有5个句子。是否有任何方法可以连接实际上应该代表相同句子的两条线？＆＃34;：
解决方案：与&连接：
示例：
Array(...)的第四项更改
来自.Item(j + 3).Text
到.Item(j + 3).Text & .Item(j + 4).Text)

问题：＆＃34;相反，当创建最后一列时，一切都以一些有趣的十字架结束（如埃及的Ankh）。知道怎么删除那些？＆＃34;：
解决方案：使用Left(string, Len(string)-1)删除问题句子中的最后一个字符，或使用Replace(string, [problem character], "")
示例：
Array(...)中的问题项（假设句子4）发生变化来自.Item(j + 3).Text
到Left(.Item(j + 3).Text, Len(.Item(j + 3).Text) - 1)

更新：

' Dim j As Long ' - make sure to have already declared this, or just uncomment this line With docCur.Sentences ' perhaps docCur.Paragraphs instead? For j = 1 To .Count If .Item(j).Bold = True Then i = i + 1 xlWS.Cells(i, 1).Resize(, 4).Value = Array(.Item(j + 0).Text, .Item(j + 1).Text, .Item(j + 2).Text, Left(.Item(j + 3).Text, Len(.Item(j + 3).Text) - 1) & .Item(j + 4).Text) End If Next j End With

如果这不是一个完整的修复程序，请提供示例文件。

VBA映射/将Word中的句子转换为Excel中的列

1 个答案: