Excel 2013宏表到列（用于文本分析）

Question

I am trying to move some data around to make it easier to do some basic text mining. I have a table with a row for each sentence, with the first column as the identifier and the following "N" columns with the words. Example:

Record  Word1   Word2   Word3   Word N
1       The     quick   brown   fox
2       jumps   over    the 
3       lazy    white       
4       dog         

I need to move the data from that table format to a list, with a word per row, with the record in which that word is located.

Example:

Record  Word
1       the
1       quick
1       brown
1       fox
2       jumps
2       over
2       the
3       lazy
3       white
4       dog

I have found macros to put the entire table in one column, but not in the way that I would need to identify in which record that word appears in. ( Excel Macros: From Table to Column )

I also found the following code here: http://community.spiceworks.com/scripts/show/1169-excel-table-to-single-column

Option Explicit

Public Sub DoCopies()
Dim lRowIdx As Long
Dim lColIdx As Long
Dim lRowStart As Long
Dim lRowOut As Long

Dim s1 As Worksheet
Dim s2 As Worksheet

Dim oBook As Workbook

Dim r As Range
Dim lRows As Long
Dim lCols As Long

  On Error GoTo errorExit

  Application.DisplayAlerts = False
  Set oBook = ThisWorkbook
  Set s1 = Worksheets(1)

  ' remove other tabs
  While (oBook.Sheets.Count > 1)
    oBook.Sheets(oBook.Sheets.Count).Delete
  Wend

  ' create the new tab
  Set s2 = oBook.Worksheets.Add(After:=oBook.Worksheets(oBook.Worksheets.Count))
  s2.Name = "Result"

  Set r = s1.UsedRange
  lCols = r.Columns.Count
  lRows = r.Rows.Count

  'skip header
  lRowStart = 1
  While (Trim$(s1.Cells(lRowStart, 1) = ""))
    lRowStart = lRowStart + 1
  Wend

  lRowStart = lRowStart + 1

  ' Take each row, put on tab 2
  For lRowIdx = lRowStart To lRows

    If (Trim$(s1.Cells(lRowIdx, 1)) <> "") Then

      For lColIdx = 1 To lCols
        lRowOut = lRowOut + 1
        s2.Cells(lRowOut, 1) = s1.Cells(lRowIdx, lColIdx)
      Next lColIdx

    End If

  Next lRowIdx

  s2.Activate

  Application.DisplayAlerts = True
  Exit Sub

errorExit:
  Application.DisplayAlerts = True
  Call MsgBox(CStr(Err.Number) & ": " & Err.Description, vbCritical Or vbOKOnly, "Unexpected Error")

End Sub

But that macro returns the data like this:

1
The
quick
brown
fox
2
jumps
over
the
<null>
3
lazy
white
<null>
<null>
4
dog
<null>
<null>
<null>

I've tried playing with the code, but can't figure it out.

Any help would be appreciated. Thanks!

Answer 1

Microsoft has effectively written most of the code for you. All that is missing is to filter column Value to select (Blanks) and then delete those rows - and change the column labels, delete a column. Details here .

Answer 2

Thanks to pnuts for pointing me in the right direction. Your link had a comment from Pankaj Jaju that provided the exact script that I needed:

Sub NormaliseTable() 
' start with the cursor in the table 
  Dim rTab As Range, C As Range, rNext As Range 
  Set rTab = ActiveCell.CurrentRegion 
  If rTab.Rows.Count=1 Or rTab.Columns.Count = 1 Then 
    MsgBox "Not a well-formed table!" 
    Exit Sub 
  End If 
  Worksheets.Add  ' the sheet for the results 
  Range("A1:C1") = Array("Row","Column","Value") 
  Set rNext = Range("A2") 
  For Each C In rTab.Offset(1,1).Resize(rTab.Rows.Count-1, _ 
         rTab.Columns.Count-1).Cells 
    If Not IsEmpty(C.Value) Then 
      rNext.Value = rTab.Cells(C.Row-rTab.Row+1,1) 
      rNext.Offset(0,1).Value = rTab.Cells(1,C.Column-rTab.Column+1)     
      rNext.Offset(0,2).Value = C.Value 
      Set rNext = rNext.Offset(1,0) 
    End If 
  Next 
End Sub

Thanks again for your guidance!