Question

Sub Exercise()              ' ' to read data from file tasks.xls and 
    Dim Arr As Variant, Arr1 As Variant  ' feed the task name for the person
    Dim iRow As Integer                  ' in a month in this file
    Dim iCol As Integer
    Dim i As Integer, x As Integer
    Dim name As String

    'name = Cells(1, 1).Value
    Arr = Workbooks.Open("E:tasks.xlsx").Sheets("Sheet1").Range("B1:E1").Value
    Arr1 = Workbooks.Open("E:tasks.xlsx").Sheets("Sheet1").Range("B2:E2").Value
    Sheets(1).Cells(1, 1).Select                  ' go to beginning cell

     For i = 1 To Arr1(1, 1)
        Cells(6, 4 + i).Value = Arr(1, 1)
        a = i + 4
    Next i


    For i = 1 To Arr1(1, 2)
        Cells(6, a + i).Value = Arr(1, 2)
        b = a + i
    Next i

    For i = 1 To Arr1(1, 3)
        Cells(6, b + i).Value = Arr(1, 3)
        C = b + i
    Next i

    For i = 1 To Arr1(1, 4)
        Cells(6, C + i).Value = Arr(1, 4)
        d = a + i
    Next i                                               

    Do While ActiveCell.Row <> Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
                                                 ' some times i get infinte loop
    ActiveCell.Offset(2, 0).Select              ' span till the last
    name = ActiveCell.Value                      '  non empty  row
    Arr = Sheets(1).Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 5)).Value
    Arr1 = Sheets(1).Range(ActiveCell.Offset(1, 1), ActiveCell.Offset(1, 5)).Value


    With ThisWorkbook.Sheets(3)            'algorithm to search the name                                                                                         '                                               positon in this excel file
    Dim findrow As Range
    Set findrow = .Range("A:A").Find(What:=name, LookIn:=xlValues)
   iRow = findrow.Row                   ' required row where name is found

    For i = 1 To Arr1(1, 1)
        Cells(iRow, 4 + i).Value = Arr(1, 1)
       a = i + 4
    Next i

    For i = 1 To Arr1(1, 2)
        Cells(iRow, a + i).Value = Arr(1, 2)
        b = a + i
    Next i

    For i = 1 To Arr1(1, 3)
        Cells(iRow, b + i).Value = Arr(1, 3)
        C = b + i
    Next i

    For i = 1 To Arr1(1, 4)
        Cells(iRow, C + i).Value = Arr(1, 4)
        d = a + i
    Next i

    Loop

End Sub

我被要求为公司设计工作分配流程。工作按指定方式分配：如果假设任务T1被分配给一个人5天，则应该在工作分配文件中连续5天显示其名称。我使用宏在MS Excel中编写了一个Visual Basic代码。我能够在正确的日期分配正确的工作，但不能分配给正确的人。。

**Workallotment.xlsm** - **Output**
Anand-Web apps              1   2   3   4   5   6   7   8   9   10  11  12  
Praveen                     T1  T1  T1  T1  T2  T2  T2  T3  T4  T4                      
Bharath Vijay                                                                           
Kailash                                                                         
Sriram                                                                          
Walter                      c1  c2  c2  c3  c3  c3  c4  c4  c4  c4                      
Harshith                                                                            
Karthik                     P1  P1  P1  P1  P1  P1  P2  P2  P2  P3  P3  P4  
Arvind                                                                          
Anirudh-Mob apps                                                                            
Sharath                                                                         

**Tasks.xls**

Praveen     T1  T2  T3  T4
            4   3   1   2
Karthik     P1  P2  P3  P4
             6  3   2   1
Walter      c1  c2  c3  c4
            1   2   3   4

I m executing the macro from 3rd sheet -May from workallotment.xlsm and invoking tasks.xls from the macro in workallotment.xlsm.The final output is in workallotment.xlsm

Answer 1

放线

End With

之前

    Loop

End Sub

并且您的错误消息应该消失。

编辑：我已经重写了您的代码，现在它适用于我。请注意，您必须更改一些Sheetnames和文件路径以适合您的工作簿。此代码进入Workallotment工作簿（作为单独的模块）：

Sub workallotment()

Dim workallotmentWB, tasksWB As Workbook
Dim waSheet As Worksheet

Dim wa_nameRng As Range

Dim wa_nameRow, wa_firstRow, wa_lastRow As Integer  'work allotment rows
Dim t_firstRow, t_lastrow As Integer                'task rows

Dim curTaskCol As Integer   'current task column
Dim wa_tmpcol As Integer    'work allotment, temp column


    Set workallotmentWB = ThisWorkbook
    Set tasksWB = Workbooks.Open("C:/users/q393996/Desktop/tasks.xlsx")

    'notes on data structure:
    '- tasks workbook:
        'first name starts in A1 of "Sheet1"
    '- workallotment workbook:
        'first name starts in A2 of Sheet named "workallotment"
        'tasks are to be written starting in B2
        'in Row 1 are headers (number of days)

    t_firstRow = 1
    wa_firstRow = 2
    wa_nameRow = 0

    Set waSheet = workallotmentWB.Worksheets("workallotment")

    With tasksWB.Worksheets("Sheet1")

        'finding the last rows
        t_lastrow = .Range("A1000000").End(xlUp).Row + 1
        wa_lastRow = waSheet.Range("A1000000").End(xlUp).Row

        'goes through all the names in tasks_Sheet1
        For r = t_firstRow To t_lastrow Step 2

            Set wa_nameRng = waSheet.Range("A:A").Find(.Range("A" & r).Value, _
            LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)

            If Not wa_nameRng Is Nothing Then

                wa_nameRow = wa_nameRng.Row

                curTaskCol = 2
                wa_tmpcol = 2

                Do While Not IsEmpty(.Cells(r, curTaskCol).Value)

                    For c = 1 To .Cells(r + 1, curTaskCol).Value
                        waSheet.Cells(wa_nameRow, wa_tmpcol).Value = .Cells(r, curTaskCol).Value
                        wa_tmpcol = wa_tmpcol + 1
                    Next c

                    curTaskCol = curTaskCol + 1

                Loop

            End If

        Next r

    End With

    MsgBox ("done")

End Sub

通常，您应始终在代码中指定要处理的工作簿和工作表。不要依赖ActiveWorkbook，ActiveCell，.Select等，因为这些可能会产生太多错误，你可能甚至都没有意识到。首先，很难理解代码，但更重要的是，如果用户无意中选择了另一个工作簿会发生什么？ ActiveCell会与你想要的完全不同。

请注意代码中的注释。如果您有任何疑问，请随时询问！：）

我收到错误消息“对象变量或未设置块变量”

1 个答案: