我完全懂你被Excel自动格式化坑惨的感受——那些+开头的零件号被当成公式、版本号2.3变成日期、德语数字格式不兼容的问题，手动处理真的太烦了。下面是一套专门针对你需求的VBA解决方案，完美避开Excel的自动转换陷阱，还带友好的用户交互：

直接从剪贴板读取原始文本数据，完全跳过Excel的自动粘贴/拆分逻辑，这样就能彻底避免数据被提前破坏。然后通过用户对话框指定分隔符和数字格式，自己控制数据拆分和格式设置的全流程。

Option Explicit

' 剪贴板API声明（兼容32/64位Excel）
#If VBA7 Then
    Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long
    Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal uFormat As Long) As LongPtr
    Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As Long
    Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As LongPtr
#Else
    Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
    Declare Function CloseClipboard Lib "user32.dll" () As Long
    Declare Function GetClipboardData Lib "user32.dll" (ByVal uFormat As Long) As Long
    Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
#End If

Const CF_UNICODETEXT = 13

Sub PasteRawDataWithCustomSettings()
    Dim rawText As String
    Dim delimiter As String
    Dim numberFormat As String
    Dim ws As Worksheet
    Dim targetCell As Range
    Dim rowsArr() As String
    Dim colsArr() As String
    Dim i As Long, j As Long
    
    ' --- 步骤1：获取用户输入 ---
    ' 选择分隔符
    delimiter = Application.InputBox("请输入数据分隔符（例如制表符输入：" & vbTab & "，空格输入： ）", "指定分隔符", vbTab, Type:=2)
    If delimiter = "" Then Exit Sub ' 用户取消
    
    ' 选择数字格式
    Dim formatChoice As Integer
    formatChoice = MsgBox("请选择数字格式：" & vbCrLf & "1. 德语格式 (1.223.443,44)" & vbCrLf & "2. 通用格式 (1,223,443.44)", vbQuestion + vbYesNoCancel, "选择数字格式")
    Select Case formatChoice
        Case vbYes
            numberFormat = "#.##0,00 €" ' 德语格式，带欧元符号可根据需求修改
        Case vbNo
            numberFormat = "#,##0.00 €" ' 通用格式
        Case vbCancel
            Exit Sub
    End Select
    
    ' 选择目标单元格
    On Error Resume Next
    Set targetCell = Application.InputBox("请选择粘贴的起始单元格", "选择目标位置", Type:=8)
    On Error GoTo 0
    If targetCell Is Nothing Then Exit Sub
    Set ws = targetCell.Parent
    targetCell = targetCell.Cells(1, 1) ' 确保是单个单元格
    
    ' --- 步骤2：从剪贴板读取原始文本 ---
    rawText = GetClipboardText()
    If rawText = "" Then
        MsgBox "剪贴板中没有文本数据！", vbExclamation
        Exit Sub
    End If
    
    ' --- 步骤3：拆分数据并写入工作表（全程文本格式） ---
    ' 拆分行
    rowsArr = Split(rawText, vbCrLf)
    If UBound(rowsArr) = -1 Then Exit Sub
    
    ' 先清空目标区域（可选，根据需求调整）
    ws.Range(targetCell, targetCell.Offset(UBound(rowsArr), UBound(Split(rowsArr(0), delimiter)))).Clear
    
    ' 设置目标区域为文本格式，避免自动转换
    ws.Range(targetCell, targetCell.Offset(UBound(rowsArr), UBound(Split(rowsArr(0), delimiter)))).NumberFormat = "@"
    
    ' 逐行逐列写入数据
    For i = 0 To UBound(rowsArr)
        If Trim(rowsArr(i)) <> "" Then ' 跳过空行
            colsArr = Split(rowsArr(i), delimiter)
            For j = 0 To UBound(colsArr)
                targetCell.Offset(i, j).Value = Trim(colsArr(j))
            Next j
        End If
    Next i
    
    ' --- 步骤4：设置数字列格式（假设最后一列是Quantity，可根据实际调整） ---
    Dim lastCol As Long
    lastCol = targetCell.Offset(0, UBound(Split(rowsArr(0), delimiter))).Column
    ws.Range(ws.Cells(targetCell.Row + 1, lastCol), ws.Cells(targetCell.Row + UBound(rowsArr), lastCol)).NumberFormat = numberFormat
    ' 将文本转换为数字（因为之前是文本格式）
    ws.Range(ws.Cells(targetCell.Row + 1, lastCol), ws.Cells(targetCell.Row + UBound(rowsArr), lastCol)).Value = _
        ws.Range(ws.Cells(targetCell.Row + 1, lastCol), ws.Cells(targetCell.Row + UBound(rowsArr), lastCol)).Value
    
    MsgBox "数据粘贴并格式化完成！", vbInformation
End Sub

' 从剪贴板读取文本的函数
Function GetClipboardText() As String
    Dim hMem As LongPtr
    Dim lpMem As LongPtr
    Dim strBuffer As String
    
    If OpenClipboard(0&) Then
        hMem = GetClipboardData(CF_UNICODETEXT)
        If hMem <> 0 Then
            lpMem = GlobalLock(hMem)
            If lpMem <> 0 Then
                strBuffer = String$(10240, Chr$(0)) ' 预分配足够的空间
                lstrcpy StrPtr(strBuffer), lpMem
                GetClipboardText = Left$(strBuffer, InStr(strBuffer, Chr$(0)) - 1)
                GlobalUnlock hMem
            End If
        End If
        CloseClipboard
    End If
End Function

1. 剪贴板读取：通过Windows API直接读取剪贴板的原始文本，完全绕过Excel的自动粘贴逻辑，确保+开头的内容不会被当成公式、点分隔的内容不会被识别为日期。
2. 用户交互：
   • 分隔符对话框：默认是制表符（最常用的复制格式），用户可以手动输入其他分隔符（比如空格、逗号）。
   • 数字格式选择：通过弹窗让用户选择德语格式或通用格式，格式字符串可根据需求修改（比如去掉欧元符号）。
3. 格式保护：写入数据前先把目标区域设置为文本格式，确保所有内容都以原始文本形式写入，之后再单独处理数字列的格式。
4. 数字转换：最后把文本格式的数字转换为对应格式的数值，既保证数据正确，又符合地区格式要求。

1. 打开Excel，按Alt + F11打开VBA编辑器。
2. 右键点击你的工作簿，选择「插入」→「模块」。
3. 把上面的代码粘贴到模块窗口中。
4. 返回Excel，按Alt + F8，选择PasteRawDataWithCustomSettings宏并运行。
5. 按照弹窗提示完成分隔符、数字格式和目标单元格的选择即可。

这个方案完美解决了你提到的所有问题：再也不用担心Excel自动破坏数据，格式设置一步到位，完全替代手动的文本转换向导操作！

内容的提问来源于stack exchange，提问作者Marek