通过 excel VBA 控制写字板
Control wordpad through excel VBA
我有一个包含 excel 个单元格的列,其中多个值由“,”或“&”(来自数据库)分隔。如何通过excelVBA控制写字板?
样本数据-
1111
1112,12311,2321,12312 & 23123
12321
1111
1115
1123, 12312
1211
1111,2321 & 2321
2321 & 1211
O/P 要求在 1 列唯一值中没有重复项。
到目前为止,我一直在 sheet 中复制数据 ---> 删除重复项。 values ---> Text To Columns ---> 1.seperate by '&' 2. 复制第二列中的值,删除 dup。和空白 ---> 将其粘贴到原始数据下方 --- > 文本到列 ---> 用 ',' 分隔 ---> 如果大于 1,则逐个复制数据 --> 在原始数据下方转置和 pste数据。
我目前正在尝试实现这里 -> 复制所有原始数据 -> 删除重复 -> 粘贴到写字板 -> 将 ',' 和 '&' 替换为 '^p'(这是我的好建议朋友,为我节省了很多时间)并替换为原始数据。
一直到粘贴写字板里的数据,不知道如何通过excelVBA替换写字板里的数据。谁能帮帮我?
'Create and copying the required range to word
Dim iTotalRows As Integer ' GET TOTAL USED RANGE ROWS.
iTotalRows = Worksheets("Quote #").UsedRange.Rows.Count
Dim iTotalCols As Integer ' GET TOTAL COLUMNS.
iTotalCols = 2
' WORD OBJECT.
Dim oWord As Object
Set oWord = CreateObject(Class:="Word.Application")
oWord.Visible = True
oWord.Activate
' ADD A DOCUMENT TO THE WORD OBJECT.
Dim oDoc
Set oDoc = oWord.Documents.Add
' CREATE A RANGE FOR THE TABLE INSIDE WORD DOCUMENT.
Dim oRange
Set oRange = oDoc.Range
' CREATE AND DEFINE TABLE STRUCTURE USING
' THE ROWS AND COLUMNS EXTRACTED FROM EXCEL USED RANGE.
oDoc.Tables.Add oRange, iTotalRows, iTotalCols
' CREATE A TABLE OBJECT.
Dim oTable
Set oTable = oDoc.Tables(1)
'oTable.Borders.Enable = True
Dim iRows, iCols As Integer
' LOOP THROUGH EACH ROW AND COLUMN TO EXTRACT DATA IN EXCEL.
For iRows = 1 To iTotalRows
For iCols = 1 To iTotalCols
Dim txt As Variant
txt = Worksheets("Quote #").Cells(iRows, iCols)
oTable.cell(iRows, iCols).Range.Text = txt ' COPY (OR WRITE) DATA TO THE TABLE.
' BOLD HEADERS.
'If Val(iRows) = 1 Then
' objTable.cell(iRows, iCols).Range.Font.Bold = True
'End If
Next iCols
Next iRows
'to replace text code reference source pasted below
With oWord.ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ","
.Replacement.Text = "^p"
.wrap = 1 '.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'reference : -
End With
Set oWord = Nothing
我正在尝试用“^p”替换“,”或“&”,哪个词将被视为新行。希望这有帮助。
O/P 要求:-
1112
12311
2321
12312
23123
12321
1111
1115
1123
1211
好的,根据评论和 post Word 不需要删除重复项。我建议在这里使用 dictionary 。以下情况的示例代码。根据我的理解,所需的输出应该类似于 C
列
以下代码将执行此操作
Option Explicit
Sub RemoveDuplicatesFromDBExtract()
Const COMMA = ","
Const AMPERSAND = "&"
Dim i As Long
Dim rg As Range
Dim sngCell As Range
Dim vDat As Variant
Dim vContent As Variant
' Add a reference to the Microsoft Scripting Runtime
' Select Tools->References from the Visual Basic menu.
' Check box beside "Microsoft Scripting Runtime" in the list.
Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
' Adjust for your need
Set rg = Range("A1:A9")
For Each sngCell In rg
vContent = Replace(sngCell.Value, COMMA, vbCrLf)
vContent = Replace(vContent, AMPERSAND, vbCrLf)
vDat = Split(vContent, vbCrLf)
For i = LBound(vDat) To UBound(vDat)
On Error Resume Next
' If vdat(i) is already in the dictionary it will not be added twice
dict.Add Trim(vDat(i)), Trim(vDat(i))
On Error GoTo 0
Next i
Next sngCell
' Write output, adjust for your needs
Range("C1").Resize(dict.Count, 1) = WorksheetFunction.Transpose(dict.Items)
End Sub
我有一个包含 excel 个单元格的列,其中多个值由“,”或“&”(来自数据库)分隔。如何通过excelVBA控制写字板?
样本数据-
1111
1112,12311,2321,12312 & 23123
12321
1111
1115
1123, 12312
1211
1111,2321 & 2321
2321 & 1211
O/P 要求在 1 列唯一值中没有重复项。
到目前为止,我一直在 sheet 中复制数据 ---> 删除重复项。 values ---> Text To Columns ---> 1.seperate by '&' 2. 复制第二列中的值,删除 dup。和空白 ---> 将其粘贴到原始数据下方 --- > 文本到列 ---> 用 ',' 分隔 ---> 如果大于 1,则逐个复制数据 --> 在原始数据下方转置和 pste数据。
我目前正在尝试实现这里 -> 复制所有原始数据 -> 删除重复 -> 粘贴到写字板 -> 将 ',' 和 '&' 替换为 '^p'(这是我的好建议朋友,为我节省了很多时间)并替换为原始数据。
一直到粘贴写字板里的数据,不知道如何通过excelVBA替换写字板里的数据。谁能帮帮我?
'Create and copying the required range to word
Dim iTotalRows As Integer ' GET TOTAL USED RANGE ROWS.
iTotalRows = Worksheets("Quote #").UsedRange.Rows.Count
Dim iTotalCols As Integer ' GET TOTAL COLUMNS.
iTotalCols = 2
' WORD OBJECT.
Dim oWord As Object
Set oWord = CreateObject(Class:="Word.Application")
oWord.Visible = True
oWord.Activate
' ADD A DOCUMENT TO THE WORD OBJECT.
Dim oDoc
Set oDoc = oWord.Documents.Add
' CREATE A RANGE FOR THE TABLE INSIDE WORD DOCUMENT.
Dim oRange
Set oRange = oDoc.Range
' CREATE AND DEFINE TABLE STRUCTURE USING
' THE ROWS AND COLUMNS EXTRACTED FROM EXCEL USED RANGE.
oDoc.Tables.Add oRange, iTotalRows, iTotalCols
' CREATE A TABLE OBJECT.
Dim oTable
Set oTable = oDoc.Tables(1)
'oTable.Borders.Enable = True
Dim iRows, iCols As Integer
' LOOP THROUGH EACH ROW AND COLUMN TO EXTRACT DATA IN EXCEL.
For iRows = 1 To iTotalRows
For iCols = 1 To iTotalCols
Dim txt As Variant
txt = Worksheets("Quote #").Cells(iRows, iCols)
oTable.cell(iRows, iCols).Range.Text = txt ' COPY (OR WRITE) DATA TO THE TABLE.
' BOLD HEADERS.
'If Val(iRows) = 1 Then
' objTable.cell(iRows, iCols).Range.Font.Bold = True
'End If
Next iCols
Next iRows
'to replace text code reference source pasted below
With oWord.ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ","
.Replacement.Text = "^p"
.wrap = 1 '.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'reference : -
End With
Set oWord = Nothing
我正在尝试用“^p”替换“,”或“&”,哪个词将被视为新行。希望这有帮助。
O/P 要求:-
1112
12311
2321
12312
23123
12321
1111
1115
1123
1211
好的,根据评论和 post Word 不需要删除重复项。我建议在这里使用 dictionary 。以下情况的示例代码。根据我的理解,所需的输出应该类似于 C
列以下代码将执行此操作
Option Explicit
Sub RemoveDuplicatesFromDBExtract()
Const COMMA = ","
Const AMPERSAND = "&"
Dim i As Long
Dim rg As Range
Dim sngCell As Range
Dim vDat As Variant
Dim vContent As Variant
' Add a reference to the Microsoft Scripting Runtime
' Select Tools->References from the Visual Basic menu.
' Check box beside "Microsoft Scripting Runtime" in the list.
Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
' Adjust for your need
Set rg = Range("A1:A9")
For Each sngCell In rg
vContent = Replace(sngCell.Value, COMMA, vbCrLf)
vContent = Replace(vContent, AMPERSAND, vbCrLf)
vDat = Split(vContent, vbCrLf)
For i = LBound(vDat) To UBound(vDat)
On Error Resume Next
' If vdat(i) is already in the dictionary it will not be added twice
dict.Add Trim(vDat(i)), Trim(vDat(i))
On Error GoTo 0
Next i
Next sngCell
' Write output, adjust for your needs
Range("C1").Resize(dict.Count, 1) = WorksheetFunction.Transpose(dict.Items)
End Sub