Question

我有一个excel电子表格，我有一个表单格式的值，我需要将它们转换为表格格式。例子 -

Project ID/Name:    3001    Miscellaneous Improvements  
Location:   This is Project Location.   
Description:    This is the project description. This is the project description. This is the project description. This is the project description. This is the project description. This is the project description. This is the project description. This is the project description.
Justification:  This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification.
Duration:       Q1 2013 to  Ongoing     
Status:     This is some status

每个块都以项目ID /名称开头，但是，描述和对齐可能会根据文本大小而有所不同。所有标题都在A列中。如果我使用Find for ProjectID - 并使用固定长度的偏移它可以工作，但如果对齐和描述更大或更小，它们就不会落在正确的位置。请帮忙。

Answer 1

您可以使用TextToColumns。例如：

'Split this cells when find ':" or <TABS>
[A1:A6].TextToColumns Destination:=[A1], DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, Tab:=True, OtherChar:=":", _
    FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

Answer 2

根据我的理解，你想要转换一个垂直的＆＃34;形式＆＃34;进入数据表。我建议将该数据添加到现有表中。

这是代码。

您需要编辑一些变量（工作表/范围名称）

Public Sub test()
    'insert your code to get each Worksheet and it's column range here
    transferFormDataToTable Range("Sheet1!B1:B100"), Worksheets(2).ListObjects(1)
End Sub

Public Sub transferFormDataToTable(yourRangeB As Range, dbTable As ListObject)
    ' make a reference to the form data range
    Dim formRange As Range
    Set formRange = yourRangeB

    'create a new ListRow in your target table
    Dim listR As ListRow
    Set listR = dbTable.ListRows.Add

    'transfer the data from form to the new ListRow
    Dim lastHeader As String
    lastHeader = ""
    Dim targetColumnOffset As Integer
    targetColumnOffset = 0
    Dim currentColumn As Integer
    currentColumn = 0
    Dim i As Integer
    For i = 1 To formRange.Count
        'if the row's header is not empty and different than previous row
        'then we'll know we have a new column of different type of data
        If lastHeader <> formRange(i).Offset(0, -1).Value And formRange(i).Offset(0, -1).Value <> "" Then
            lastHeader = formRange(i).Offset(0, -1).Value
            targetColumnOffset = 0
            currentColumn = currentColumn + 1
        End If

        'this loop captures data that might have been placed in columns to the right of the input cell
        Dim rowString As String
        rowString = ""
        Dim j As Integer
        j = 0
        Do While True
            If formRange(i).Offset(0, j).Value <> "" Then
                If rowString = "" And targetColumnOffset = 0 Then
                    rowString = formRange(i).Offset(0, j).Value
                Else
                    rowString = rowString & "; " & formRange(i).Offset(0, j).Value
                End If
                j = j + 1
            Else
                Exit Do
            End If
        Loop

        If targetColumnOffset = 0 Then
            listR.Range(currentColumn).Value = rowString
        Else
            listR.Range(currentColumn).Value = listR.Range(currentColumn).Value & rowString
        End If

        targetColumnOffset = targetColumnOffset + 1

        'Exit the loop if it seems to get the end
        If formRange(i).Value = "" And formRange(i).Offset(0, -1).Value = "" Then _
            Exit For
    Next i
End Sub

注意：

使用只有1行或2行的VBA空表创建编辑时，Excel偶尔会出现奇怪的错误。我建议仅在表格有3行以上时使用此宏。
如果您想要更完整的版本，请发给我一个说明。也就是说，这个简短版本最终可能遇到的问题是，如果用户切换列，代码就会搞砸。

修改

我只是根据您的要求调整了代码。尽管如此，这肯定会越来越多。我真的想让团队确信他们需要多少才能找到更合适的工具。祝你好运。

在Excel宏中的现有查找循环中查找

2 个答案: