将列复制到记事本中

Question

我有以下 Excel VBA 代码来打开记事本并将 Excel 列复制到记事本中。

    Dim wsSource As Worksheet
    Dim rDataRange As Range
    Dim rCell As Range
    Dim sCellContent As String
    Dim sStringout As String
    Dim lrowData As Long                                        ' XXX Added
  
'   This is worksheet where data is located.
    Set wsSource = ThisWorkbook.Worksheets("Data")
  
'   This is where data to be processed is located.
    lrowData = wsSource.Range("G" & Rows.Count).End(xlUp).Row   ' XXX Added
    Set rDataRange = wsSource.Range("G40:H" & lrowData)         ' XXX Modified
  
'   Iterate through all source data cells.
    For Each rCell In rDataRange.Columns(1).Cells               ' XXX Loop modified
      
'   Add the cell's content to the full output string
    sStringout = sStringout & rCell.Value & " " & rCell.Offset(, 1).Value & ";"
      
    Next rCell
  
'   Remove trailing semi-colon
    sStringout = Left(sStringout, Len(sStringout) - 1)
  
'   Start Notepad with focus
    Shell "C:\windows\system32\notepad.exe", vbNormalFocus
    
'   Put the string into the free notepad.
    SendKeys sStringout

这会将所有内容复制到一行。

列 G 和 H 应复制到两行。
一个用于 G，下面一个用于 H。

看起来应该是这样的。

column G -> mail;policy;E164;VoiceRoutingPolicy;Language;DialPlan
column H -> [email protected];UpgradeToTeams;111111111;VRP-GEN-BE-Europe_Zone2;en-US;BE

Answer 1

修改代码的“简单解决方案”是

Sub twolines()
    Dim wsSource As Worksheet
    Dim rDataRange1 As Range
    Dim rDataRange2 As Range
    Dim rCell As Range
    Dim sCellContent As String
    Dim sStringout As String
    Dim lrowData As Long                                        ' XXX Added
  
'   This is worksheet where data is located.
    Set wsSource = ActiveWorkbook.Worksheets("Data")
  
'   This is where data to be processed is located.
    lrowData = wsSource.Range("G" & Rows.Count).End(xlUp).Row   ' XXX Added
    
    
    Set rDataRange1 = wsSource.Range("G40:G" & lrowData)         ' XXX Modified
    Set rDataRange2 = wsSource.Range("H40:H" & lrowData)         ' XXX Modified
  
'   Iterate through all source data cells.
    For Each rCell In rDataRange1.Cells               ' XXX Loop modified
'   Add the cell's content to the full output string
    sStringout = sStringout & rCell.Value & ";"
    Next rCell
  
'   Remove trailing semi-colon
    sStringout = Left(sStringout, Len(sStringout) - 1)
'   NewLine
    sStringout = sStringout & Chr(13) & Chr(10)
  
    For Each rCell In rDataRange2.Cells               ' XXX Loop modified
'   Add the cell's content to the full output string
    sStringout = sStringout & rCell.Value & ";"
    Next rCell
  
  
'   Remove trailing semi-colon
    sStringout = Left(sStringout, Len(sStringout) - 1)
  
'   Start Notepad with focus
    Shell "C:\windows\system32\notepad.exe", vbNormalFocus
    
'   Put the string into the free notepad.
    SendKeys sStringout
End Sub

但是：有些人认为“sendkeys”是一种不好的行为，因为它很难控制，用户可以通过与 PC 交互来更改结果....

另一种可能性是使用此函数编写一个现成的 txt 文件：

Function write_textfile(pathandname_file As String, text As String)
On Error GoTo Ende
Dim Datei As String
Dim Fnr As Long

    Datei = Mid(pathandname_file, 1, Len(pathandname_file) - 3) & "txt"
    Fnr = FreeFile
    Open Datei For Output As Fnr
Print #Fnr, text
    Close Fnr
    Exit Function

Ende:
End Function

将“sendkeys”替换为“write_textfile c:\myfile.txt, stringout”