我正在寻找用于执行以下操作的宏VBA代码，我几乎每天都需要手动执行此操作。
我正在写下我必须手动执行的步骤，以便回复此查询的用户明白该过程：
从.txt文件复制并粘贴excel工作簿数据，如下所示 LT绝缘子 - 卸扣绝缘子 - Wipro Industries 闪电逮捕者 - Elpro International 导体 - ACSR Raccoon - HHI Industries 数据粘贴在A列中。这些数据长度可变，可以在500-700行之间。
使用文本到列（用' - '作为分隔符分隔）在Col A和B中分配数据，其中有2个短语，C有3个短语。如果有2个短语，我需要Col B中的数据移动到C列（因为这是Col for Makes）。对于2个短语数据，在“文本到列”操作之后，Col C将保持空白，并且可能应该是将数据从Col B移动到Col C的标准。在此步骤之后，表格应如下所示： LT绝缘子卸扣绝缘子Wipro Industries 闪电逮捕者Elpro国际 导体ACSR Raccoon HHI Industries
然后我将= TRIM（）函数应用于Col A和C（不需要Col B），因为数据来自文本文件。修剪后的值也可以在其他列中，可以在原始列中粘贴值。
我不熟悉宏VBA编码，因此无法正确绘制。任何帮助将不胜感激。
这是我的代码，它返回运行时1004的错误。粘贴方法失败或类似的东西。
Sub Dataedit() ' ' Dataedit Macro ' Edits data for report '
'
ActiveSheet.Paste
Range("A1:A154").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("A:A").ColumnWidth = 27
Columns("B:B").ColumnWidth = 28.57
Columns("A:A").ColumnWidth = 31.29
Range("B1:B11").Select
Selection.Cut Destination:=Range("C1:C11")
Range("C1:C11").Select
Columns("C:C").ColumnWidth = 15.43
ActiveWindow.SmallScroll Down:=6
Range("B13:B14").Select
Selection.Cut Destination:=Range("C13:C14")
Range("B18:B19").Select
Selection.Cut Destination:=Range("C18:C19")
Range("C18:C19").Select
ActiveWindow.SmallScroll Down:=9
Range("B27:B28").Select
Selection.Cut Destination:=Range("C27:C28")
Range("B30:B32").Select
Selection.Cut Destination:=Range("C30:C32")
Range("C30:C32").Select
ActiveWindow.SmallScroll Down:=9
Range("B36:B45").Select
Selection.Cut Destination:=Range("C36:C45")
Range("C36:C45").Select
ActiveWindow.SmallScroll Down:=12
Range("B46:B53").Select
Selection.Cut Destination:=Range("C46:C53")
Range("C46:C53").Select
ActiveWindow.SmallScroll Down:=9
Range("B55:B62").Select
Selection.Cut Destination:=Range("C55:C62")
Range("C55:C62").Select
ActiveWindow.SmallScroll Down:=12
Range("B64:B67").Select
Selection.Cut Destination:=Range("C64:C67")
Range("C64:C67").Select
ActiveWindow.SmallScroll Down:=30
Range("B94:B104").Select
Selection.Cut Destination:=Range("C94:C104")
Range("B105").Select
Selection.Cut Destination:=Range("C105")
Range("C105").Select
ActiveWindow.SmallScroll Down:=27
Range("B128:B136").Select
Selection.Cut Destination:=Range("C128:C136")
Range("C128:C136").Select
ActiveWindow.SmallScroll Down:=-147
Range("E1").Select
ActiveCell.FormulaR1C1 = "=TRIM(RC[-4])"
Range("F3").Select
Columns("E:E").ColumnWidth = 20.71
Columns("F:F").ColumnWidth = 27.71
Range("F1").Select
ActiveCell.FormulaR1C1 = "=TRIM(RC[-3])"
Range("E1:F1").Select
Selection.AutoFill Destination:=Range("E1:F154"), Type:=xlFillDefault
Range("E1:F154").Select
Range("F160").Select
ActiveWindow.SmallScroll Down:=-183
Range("E1:E154").Select
Selection.Cut
ActiveWindow.SmallScroll Down:=-15
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Range("F4").Select
Application.CutCopyMode = False
Range("E1:E154").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("F1:F154").Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D15").Select
Application.CutCopyMode = False
Range("E1:F154").Select
Selection.ClearContents
Range("D11").Select
ActiveWindow.SmallScroll Down:=-51
Range("A1:C154").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C1:C154") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C1:C154") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:C154")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=81
ChDir "D:\"
ActiveWorkbook.SaveAs Filename:="D:\File List.xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Selection.ClearContents
Range("E10").Select
ActiveWorkbook.Save End Sub
答案 0 :(得分：0)
这是我的看法。不确定粘贴是否正常工作。
我避免使用select，因为它只会减慢代码速度。我还修剪了A列和A列中的数据。 C就地而不是将其复制到E＆amp; F列。
我假设数据位于名为Book1的工作簿中。您当然可以在宏中重命名工作簿和工作表。
Sub DataEdit()
Dim wb As Workbook
Dim ws As Worksheet
Dim GCell As Range
Dim NumberOfRowsOfData, Count As Integer
Set wb = Workbooks("Book1")
With wb
Set ws = .Worksheets("Sheet1")
With ws
Set GCell = .Range("A1")
GCell.PasteSpecial
GCell.TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Set GCell = .Range("A:A")
NumberOfRowsOfData = .Range("A10000").End(xlUp).Row
GCell.ColumnWidth = 27
Set GCell = .Range("B:B")
GCell.ColumnWidth = 28.57
Set GCell = .Range("C:C")
GCell.ColumnWidth = 31.29
For Count = 1 To NumberOfRowsOfData
If .Cells(Count, 3) = "" Then
.Cells(Count, 3).Value = Cells(Count, 2).Value
.Cells(Count, 2).ClearContents
.Cells(Count, 1).Value = Trim(.Cells(Count, 1).Value)
.Cells(Count, 3).Value = Trim(.Cells(Count, 3).Value)
End If
Range("A1:C" & NumberOfRowsOfData).Sort key1:=Range("C1:C" & NumberOfRowsOfData), order1:=xlAscending, Header:=xlNo
Next Count
End With
End With
End Sub