0 
id\date | 1 |  2  | 3  | 4  | 5  | 6  | 7
111     | q |  a  | q  | a  | a  | a  | a
112     | a |  q  | q  | q  | a  | q  | a
113     | w |  w  | a  | w  | w  | a  | a
114     | w |  a  | q  | q  | w  | w  | w
115     | a |  a  | a  | a  | a  | w  | a

这是我在 excel 表中的表格示例，我希望在另一张表中显示以下输出，在输出表中我们忽略“a”

id   | code |  start_date   |  end_date   |  total
111  |  q   |  01-01-2013   | 01-01-2013  |     1
111  |  q   |  03-01-2013   | 03-01-2013  |     1
112  |  q   |  02-01-2013   | 04-01-2013  |     3
112  |  q   |  06-01-2013   | 06-01-2013  |     1
113  |  w   |  01-01-2013   | 02-01-2013  |     2
113  |  w   |  04-01-2013   | 05-01-2013  |     2
114  |  w   |  01-01-2013   | 01-01-2013  |     1
114  |  q   |  03-01-2013   | 04-01-2013  |     2
114  |  w   |  05-01-2013   | 07-01-2013  |     3
115  |  w   |  06-01-2013   | 06-01-2013  |     1

就像在下面的输出中一样，我想创建一个 Excel 表，其中在“id”中我们获取员工 id 和代码列中的代码，即“q”或“w”以及开始日期和结束日期。开始日期和结束日期取决于代码是否仅在一个日期，如果是，则开始日期和结束日期保持不变，但如果代码连续 2 天或更长时间，则开始日期是事件的开始日期和结束日期是什至结束的时候。即使在同一类型的两个事件之间存在单个间隙，也必须像员工 113 一样输入两个条目。请检查输出，如果您可以为我提供完成输出的功能，它将帮助我很多。

4

1 回答 1

0

下面是我想出的模块。VBA 编码器不多，但我尽了最大努力，一些硬编码就像我假设为“Sheet1”和“Sheet2”的工作表名称，您可以根据需要更改它们，并且可以使用更整洁的嵌套 IF：

            Sub test()
            Dim hold_last_value As String 'To hold the value of code of previous cell for a given id
            Dim counter As Integer 'To hold the value of days count for which a given event was held continuously for a given id
            Dim from_date As Variant 'To hold the start date of the event
            Dim to_date As Variant 'To hold the end date of an event
            Dim row_writer_index As Integer 'To hold the value of the row to which the next output is to be written, Is passed as a ByRef argument to the function
            Dim lastid As Integer 'To hold the last looped ID, In case the row changes without the event being stopped at the last date
            Dim last_row As Integer 'To generalize the code to parse any amounts of row
            Worksheets("Sheet1").Activate
            hold_last_value = 0
            counter = 0
            row_writer_index = 1
            last_row = ActiveSheet.UsedRange.Rows.Count

             '' To loop the IDs
             For Each col_looper In Range("A2:A" & last_row)
              row_num = col_looper.Row
              'MsgBox (col_looper & row_num)
              '' To loop the events for each IDs
              For Each row_looper In Range("B" & row_num, "H" & row_num)
                'MsgBox (row_num & row_looper)
                row_looper.Value = Application.WorksheetFunction.Trim(row_looper.Value)
                ''Condition for row changes without the event being stopped at the last date
                If (lastid <> col_looper.Value And counter <> 0) Then
                  Call writer(hold_last_value, lastid, from_date, to_date, counter, ThisWorkbook.Worksheets("Sheet2"), row_writer_index)
                  counter = 0
                  from_date = Null
                  to_date = Null
                ElseIf (row_looper.Value <> "a" And counter = 0) Then
                  'MsgBox (col_looper & "--" & row_looper & "---" & row_num & "---" & hold_last_value & "---" & from_date & "---" & to_date & "---" & counter)
                  counter = 1
                  hold_last_value = row_looper.Value
                  from_date = Cells(1, row_looper.Column).Value
                  to_date = Cells(1, row_looper.Column)
                ElseIf (row_looper.Value = "a" And counter <> 0) Then
                  'MsgBox (col_looper & "--" & row_looper & "---" & row_num & "---" & hold_last_value & "---" & from_date & "---" & to_date & "---" & counter)
                  Call writer(hold_last_value, col_looper.Value, from_date, to_date, counter, ThisWorkbook.Worksheets("Sheet2"), row_writer_index)
                  hold_last_value = ""
                  counter = 0
                  from_date = Null
                  to_date = Null
                ElseIf (row_looper.Value <> "a" And counter <> 0 And hold_last_value = row_looper.Value) Then
                  'MsgBox (col_looper & "--" & row_looper & "---" & row_num & "---" & hold_last_value & "---" & from_date & "---" & to_date & "---" & counter)
                  counter = counter + 1
                  to_date = Cells(1, row_looper.Column)
                ElseIf (row_looper.Value <> "a" And counter <> 0 And hold_last_value <> row_looper.Value) Then
                  'MsgBox (col_looper & "--" & row_looper & "---" & row_num & "---" & hold_last_value & "---" & from_date & "---" & to_date & "---" & counter)
                  Call writer(hold_last_value, col_looper.Value, from_date, to_date, counter, ThisWorkbook.Worksheets("Sheet2"), row_writer_index)
                  hold_last_value = row_looper.Value
                  counter = 1
                  from_date = Cells(1, row_looper.Column).Value
                  to_date = Cells(1, row_looper.Column).Value
                Else
                End If
                lastid = col_looper.Value
              Next row_looper
             Next col_looper

            End Sub
            '' WRITER FUNCTION
            Private Function writer(ByVal code As String, ByVal id As Integer, ByVal from_date As Variant, ByVal to_date As Variant, ByVal total As Integer, ByVal sheet_name As Worksheet, ByRef row_writer_index As Integer)
              Dim ws As Worksheet
              Dim x As Integer
              Dim a As Integer
              Set ws = sheet_name
              a = id
              ws.Activate
              ws.Range("A" & row_writer_index) = id
              ws.Range("B" & row_writer_index) = code
              ws.Range("C" & row_writer_index) = from_date
              ws.Range("D" & row_writer_index) = to_date
              ws.Range("E" & row_writer_index) = total
              Worksheets("Sheet1").Activate
              row_writer_index = row_writer_index + 1
              x = row_writer_index
            End Function
于 2013-07-05T04:16:06.923 回答