0

如何使用条件将数据从剪贴板粘贴到 Excel 以将数据拆分为 2 个单独的列？

例如，我的剪贴板中有这个：

8:01
17:01
7:56
17:02
7:56
17:00
7:53
17:01
7:56
17:01
7:57
17:02
7:56
17:01
7:56
17:00
7: 56
17:02

我想将低于 10:00 的值粘贴到 A 列中，将大于 10:00 的值粘贴到 B 列中，这样结果将是：

      A B
1 8:01 17:01
2 7:56 17:02
3 7:56 17:00
4 7:53 17:01
5 7:56 17:01
6 7:57 17:02
7 7:56 17:01
8 7:56 17:00
9 7:56 17:02

到目前为止，我唯一管理的是将它们全部粘贴到一列中，然后使用过滤器，然后手动将值复制并粘贴到两个不同的列中

在此处输入图像描述

4

5 回答 5

0

编辑：将以下方法粘贴到模块或包含数据的工作表中

Option Explicit
Sub SplitCellsForValue(ByVal splitValue As Integer)
Dim source As Range
Dim cell
Dim currentValue

Dim rowForColumn1Ctr As Integer
Dim rowForColumn2Ctr As Integer

Dim column1Ctr As Integer
Dim column2Ctr As Integer

Dim maxRowsAfterSplit As Integer

rowForColumn1Ctr = 1
rowForColumn2Ctr = 1

'** Put your source range here
Set source = Range("A1:A7")

maxRowsAfterSplit = CInt(source.Rows.Count / 2)
For Each cell In source.Cells
    currentValue = Val(Replace(cell.Text, ":", ""))

    If currentValue < splitValue Then
        Range("B" & rowForColumn1Ctr) = cell.Text
        rowForColumn1Ctr = rowForColumn1Ctr + 1
    Else
        Range("C" & rowForColumn2Ctr) = cell.Text
        rowForColumn2Ctr = rowForColumn2Ctr + 1
    End If
Next
End Sub

用法：（您可以从即时窗口调用以下内容）

SplitCellsForValue 1000

在上面的示例中，它从 A1:A7 获取数据（根据您的情况进行更改）并通过给定参数（值：1000）拆分内容SplitCellsForValue并将内容放入“B”和“C”列 - 您可以更改.

注意：值 1000 = 10:00，其中 : 已删除。

于 2013-04-06T20:17:36.127 回答
0

如果您粘贴以下 vba 代码并在您粘贴了值的工作表上运行它，您将按照要求得到两列。

Sub cell_to_column()

    Dim lastrow as long, currentpaste as long
    'find last row
    lastrow = Columns("A:A").Find("*", range("A1"), xlValues, , xlByRows, xlPrevious).row
    currentpaste =1

    'cycle through all cells in column a
    For each a in range(cells(1,1), cells(lastrow,1))

        If len(trim(a.value)) >= 5 then 'if found 10:00 or larger

            'if a value if found copy its value over 
            Cells(currentpaste, 2).value = a.Value
            A.value = ""
            Currentpaste = currentpaste +1

        End if

    Next

    'remove all blank cells
    range(cells(1,1), cells(lastrow,1)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

End sub
于 2013-04-06T20:32:34.287 回答
0

另一种方式...此代码也将进行粘贴。您不必手动进行:)

Sub Macro1()
    Dim ws As Worksheet
    Dim LastRow As Long, startRowA As Long, startRowB As Long
    Dim i As Long

    On Error GoTo Whoa

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    startRowA = 1: startRowB = 1

    With ws
        '~~> Using this as you are copying it from Notepad~~~~
        .Activate
        .Range("A1").Select
        .PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 1 To LastRow - 1 Step 2
            .Range("C" & startRowA).Value = .Range("A" & i).Value
            startRowA = startRowA + 1
        Next i

        For i = 2 To LastRow Step 2
            .Range("D" & startRowB).Value = .Range("A" & i).Value
            startRowB = startRowB + 1
        Next i
    End With

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

在此处输入图像描述

跟进

问题显然是希伯来语版本的 Excel。

于 2013-04-06T20:50:24.057 回答
0

如果您不想编写宏，请执行以下操作：

  1. 将值粘贴到 A1 中。
  2. 开B1，键入=OFFSET(A1,ROW()-ROW($A$1),0)
  3. 开C1，键入=OFFSET(A1,ROW()-ROW($A$1)+1,0)
  4. 格式化B1并C1进入时间。否则，它将显示为一个数字。
  5. 选择B1然后C1粘贴下来。
于 2013-04-06T20:59:58.553 回答
0

不要粘贴到记事本中（即先返回一步），粘贴到 Word 中，插入 > 表格 - 表格，将文本转换为表格并选择列：2，然后再粘贴到 Excel 中。

于 2013-04-06T21:29:03.113 回答