在列中查找行号并移动数据Excel vba

Question

我希望你们能帮助我。我有一个 Excel 表，其中包含我想复制一些值并将它们移动到另一列的数据。

目前的数据是这样的：

A           B
...
20:00:00    2456
21:00:00    2147
22:00:00    5623
23:00:00    1247
00:00:00    3549
01:00:00    1234
...

我有几天的数据，当我发现字符串“00:00:00”是另一天的开始时，我想将之前的 24 个值复制到下一列。

结果应该是这样的：

A           B       C      D
...
20:00:00    2456
21:00:00    2147
22:00:00    5623
23:00:00    1247
00:00:00            3549
01:00:00            1234
...
22:00:00            2418
23:00:00            3245
00:00:00                   3549
01:00:00                   5437

我已经开始尝试找到等于“00:00:00”的值的行号，将它们保存在一个数组中，然后在行值（i+1）“00:00:00”之间求差" 和行值(i) "00:00:00"

感谢和问候， 丹尼尔·杜阿尔特

Answer 1

这已经测试过了：

Sub move()
Dim column As Integer
column = 3

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row

   If Cells(i + 1, 1).Value > Cells(i, 1).Value and Cells(i + 1, 1).Value <> "" Then
      Cells(i, column).Value = Cells(i, 2).Value
      Cells(i, 2).Value = ""
   Else
      column = column + 1
      Cells(i, column).Value = Cells(i, 2).Value
      Cells(i, 2).Value = ""
   End If

Next

End Sub

在这种情况下需要注意的是，它正在检查下一个小时是否小于当前时间，即小时在午夜回到零并且它也会增加它粘贴的列。它将在 24 小时窗口内的任何时间工作，与分钟/秒无关

Answer 2

您提到了“24”，所以我一直认为它是 24 个元素。时间是一致的还是可变的？

VBA 中的解决方案如下。

鉴于这样的事情：

time    value
20:00   100
21:00   200
22:00   300
23:00   400
0:00    500
1:00    600
2:00    700
3:00    800
4:00    900
5:00    1000
6:00    1100
7:00    1200
8:00    1300
9:00    1400
10:00   1500
11:00   1600
12:00   1700
13:00   1800
14:00   1900
15:00   2000
16:00   2100
17:00   2200
18:00   2300
19:00   2400
20:00   2500
21:00   2600
22:00   2700
23:00   2800
0:00    2900
1:00    3000
2:00    3100
3:00    3200
4:00    3300
5:00    3400
6:00    3500
7:00    3600
8:00    3700
9:00    3800
10:00   3900
11:00   4000
12:00   4100
13:00   4200
14:00   4300
15:00   4400
16:00   4500
17:00   4600
18:00   4700
19:00   4800
20:00   4900
21:00   5000
22:00   5100
23:00   5200

这是你要找的吗？

Option Explicit
Sub shift()
      Dim Test As String
      Dim NumRows As Integer
      Dim CurrentRow As Integer
      Dim ToCopy As String
      Dim x As Integer
      Dim i As Integer
      ' Set numrows = number of rows of data.
      NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
      ' loop around
      For x = 0 To NumRows - 1
         Range("A2").Offset(x, 0).Select
         Test = ActiveCell.Text
         If Val(Test) = 0 Then
         CurrentRow = ActiveCell.Row
            If ((CurrentRow - 24) > 1) Then
                For i = 1 To 24
                        If ((CurrentRow - i - 24) > 0) Then
                            ToCopy = ActiveCell.Offset(-i - 24 + 1, 1).Text
                            ActiveCell.Offset(-i + 1, 2).Value = ToCopy 
                        End If
                Next i
            End If
         Else

         End If


      Next



End Sub

Answer 3

针对任意情况修改它；例如，时差为 0:15。

这有点罗嗦/悬而未决，但给了你想法。

Option Explicit

Sub shift_arb()
      Dim Test As String
      Dim StartRow As Integer
      Dim EndRow As Integer
      Dim NumRows As Integer
      Dim nZeroRows As Integer
      Dim CurrentRow As Integer
      Dim ToCopy As String
      Dim x As Integer
      Dim i As Integer
      ' Set numrows = number of rows of data.
      NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 0 To NumRows - 1
         Range("A2").Offset(x, 0).Select
         Test = ActiveCell.Text

         ' If we meet the critera; store the row values of the zero rows
         If TimeValue(Test) = "12:00:00 AM" Then
            nZeroRows = nZeroRows + 1
            StartRow = EndRow
            EndRow = ActiveCell.Row

             ' Only do this if you've hit the second zero row
             ' After this, we have to backfill the first, since we don't know the
             ' gap between the zeros
             If (nZeroRows > 1) Then
             ' Go from one zero row to the next

                For i = 0 To (EndRow - StartRow)

                    If ((StartRow - i) > 1) Then
                        ToCopy = Cells(StartRow - i, 2).Text
                        Cells(EndRow - i, 3).Value = ToCopy
                    End If

                Next i

                End If

            End If

        Next x

        ' At the end, cleanup, and do the rest.
        Debug.Print StartRow, EndRow, ActiveCell.Row
        For i = 0 To (EndRow - StartRow)
            If ((i + EndRow - 1) < ActiveCell.Row) Then
                ToCopy = Cells(StartRow + i, 2).Text
                Cells(EndRow + i, 3).Value = ToCopy
            End If
        Next i

End Sub