Question

我是Excel VBA编程的初学者，有15天的工作经验，我使用宏录制功能与VBA合作，非常适合。

我有一个由以下列组成的工作表：Level，Id，Work-Product，Start，End

级别列包含级别1,2,3,4，另一个包含随机数据。因此，基本上第1级将包括：

   Level    ID  Work Product    Start       End
    1       A1  ABCD            1.1.2011    1.1.2013

同样，2,3和4级由一些数据组成。现在，我的任务是创建一个看起来像这样的变量块：

'First Block Borders
'
    Range("O12:V13,O14:V14,O15:V15,O16:V16,O17:V17").Select
    Selection.BorderAround ColorIndex:=xlColorIndexAutomatic

'为第一个块的合并循环工作

Dim row As Long

For row = 12 To 17
    If row = 12 Then
        Range(Cells(row, 15), Cells(row + 1, 22)).Merge
        row = row + 1
    Else
        Range(Cells(row, 15), Cells(17, 22)).Select
        Selection.Merge True
        Exit For
    End If
Next row

现在，我有两个问题：

这个问题的第一个问题是这里创建的块是一个固定块，我希望它是灵活的，这样如果任何人想要它只需要前4列，那么他就可以用类似的大纲或如果他想添加另一个级别，它也是可能的，并且程序会自动创建另一个级别，或者如果用户添加新列，则类似地在块中添加另一行。

第二个问题是关于级别，我想使用循环自动设置级别，以便在查看级别数后，程序会自动创建包含内容的块。

我已经彻底搜索了所有论坛帖子和互联网以获得答案，但我无法自动完成此操作。我的缺点是我还处于学习阶段，我知道上面的任务需要一些经验和一些非宏相关的编码。

你们中的任何人都可以帮助我完成这项任务，我将非常感激。

由于

感谢您的回复，对不起，如果我的问题得不到正确理解。我现在试着让它更清楚。

有2个工作表工作表1由Data_Model组成，如下所示：

Level  ID     Start         End             PT

1      A1     01.10.2012    30.09.2013  271.39
2      A1.1   01.10.2012    30.09.2013  83
3      A1.2   01.10.2012    30.09.2013  125.89

第二个工作表将包含此工作表中的数据，但形式不同。它是一个WBS（工作分解结构）树。我上面发布的块的例子是我想象的块的估计大小。现在，我已经制作了WBS树，但是当我修复了“在列”O“和”V“”中创建数据边界时，我得到了所有错误的要求。

我想在这里实现的是以编程方式，如果我运行此VBA脚本，它应该执行以下操作：

在secons工作表中创建一个框（类似于我在第一篇文章中放置的尺寸）。
如果用户稍后在第一个工作表中插入新列，则脚本应根据第一个工作集中的列的添加和删除来允许更新该框。
级别2,3,4,5应低于第一个块，并且还应包含以下功能：如果用户在第一个工作表中插入具有新级别的新行，则应自动添加新块第二个工作表中所需的尺寸。

我所使用的以下代码或多或少是硬编码的，并不包含上述功能，但是如果你运行它，那么你可能知道我在说什么。

Option Explicit


Sub Sixth_Tree()


'First Block Borders
'
Range("EH12:EO13,EH14:EO14,EH15:EO15,EH16:EO16,EH17:EO17").Select
Selection.BorderAround ColorIndex:=xlColorIndexAutomatic


'Merge First Borders


' Range(Cells(12, 15), Cells(13, 22)).Merge
' Range(Cells(14, 15), Cells(17, 22)).Merge True



'Working for loop for first block


'Dim row As Long
'
'For row = 12 To 17
' If row = 12 Then
' Range(Cells(row, 15), Cells(row + 1, 22)).Merge
' row = row + 1
' Else
' Range(Cells(row, 15), Cells(17, 22)).Select
' Selection.Merge True
' Exit For
' End If
'Next row

'Test For loop for multiple blocks merge


'Dim row As Long
' For row = 12 And 20 And 26 And 34 And 41 To 46
' If row = 12 And 20 And 26 And 34 And 41 Then
' Range(Cells(row, 15), Cells(row + 1, 22)).Merge
' row = row + 1
' Else
' Range(Cells(row, 15), Cells(17, 22)).Select
' Selection.Merge True
' Exit For
' End If
'Next row


'Merge 1st block For Loop


Dim irow As Long, icol As Long
icol = 138
For irow = 12 To 17


If irow = 12 Then
Range(Cells(irow, 138), Cells(irow + 1, 145)).Merge
irow = irow + 1


Else
Range(Cells(irow, 138), Cells(17, 145)).Select
Selection.Merge True
Exit For
End If


Next irow


'Second block Borders


Range("EJ20:EQ21,EJ22:EQ22,EJ23:EQ23,EJ24:EQ24,EJ25:EQ25").Select
Selection.BorderAround ColorIndex:=xlColorIndexAutomatic

'Merge 2nd block For Loop


icol = 140
For irow = 20 To 25


If irow = 20 Then
Range(Cells(irow, 140), Cells(irow + 1, 147)).Merge
irow = irow + 1


Else
Range(Cells(irow, 140), Cells(25, 147)).Select
Selection.Merge True
Exit For
End If


Next irow

'Merge second Borders


Range(Cells(20, 17), Cells(21, 24)).Merge
Range(Cells(22, 17), Cells(25, 24)).Merge True


'Third block Borders


Range("EJ27:EQ28,EJ29:EQ29,EJ30:EQ30,EJ31:EQ31,EJ32:EQ32").Select
Selection.BorderAround ColorIndex:=xlColorIndexAutomatic

'Merge 3rd block For Loop


icol = 140
For irow = 27 To 32


If irow = 27 Then
Range(Cells(irow, 140), Cells(irow + 1, 147)).Merge
irow = irow + 1


Else
Range(Cells(irow, 140), Cells(32, 147)).Select
Selection.Merge True
Exit For
End If


Next irow


'Merge Third Borders


Range(Cells(27, 17), Cells(28, 24)).Merge
Range(Cells(29, 17), Cells(32, 24)).Merge True

'Fourth block Borders


Range("EJ34:EQ35,EJ36:EQ36,EJ37:EQ37,EJ38:EQ38,EJ39:EQ39").Select
Selection.BorderAround ColorIndex:=xlColorIndexAutomatic

'Merge 4th block For Loop


icol = 140
For irow = 34 To 39


If irow = 34 Then
Range(Cells(irow, 140), Cells(irow + 1, 147)).Merge
irow = irow + 1


Else
Range(Cells(irow, 140), Cells(39, 147)).Select
Selection.Merge True
Exit For
End If


Next irow


'Merge Fourth Borders


Range(Cells(34, 17), Cells(35, 24)).Merge
Range(Cells(36, 17), Cells(39, 24)).Merge True


'Connecting Lines
'
Range("EI18:EI34").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
End With


Range("EI20, EI27, EI34").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With


'Color


' Range("O12:V13,Q20:X21,Q27:X28,Q34:X35,Q41:X42").Select
' With Selection.Interior
' .Pattern = xlSolid
' .ThemeColor = xlThemeColorLight2
' .TintAndShade = 0.799981688894314
' End With
'
' Range("O14:V14,Q22:X22,Q29:X29,Q36:X36,Q43:X43").Select
' With Selection.Interior
' .Pattern = xlSolid
' .ThemeColor = xlThemeColorDark2
' .TintAndShade = -0.249977111117893
' End With
'
' Range("O17:V17,Q25:X25,Q32:X32,Q39:X39,Q46:X46").Select
' With Selection.Interior
' .Pattern = xlSolid
' .ThemeColor = xlThemeColorLight2
' .TintAndShade = 0.599993896298105
' End With
'
'Copying from the Data_Model and alignment


Application.ScreenUpdating = False
With Sheets("Data_Model")
.Range("C77").Copy Sheets("Tabelle1").Range("EH12:EO13")
.Range("C78").Copy Sheets("Tabelle1").Range("EJ20:EQ21")
.Range("C79").Copy Sheets("Tabelle1").Range("EJ27:EQ28")
.Range("C80").Copy Sheets("Tabelle1").Range("EJ34:EQ35")
End With
'
''Hard Coding the the 4 sub-cells in the block
'
' Dim irow As Long, irow1 As Long, icol As Long
'
' icol = 15
' For irow = 14 To 22 Step 8
' Cells(irow, icol).Value = "Aufwand/Summe: "
' Cells(irow + 1, icol).Value = "Start: "
' Cells(irow + 2, icol).Value = "Ende: "
' Cells(irow + 3, icol).Value = "Verantw: "
' icol = 17
' For irow1 = 29 To 46 Step 7
' Cells(irow1, icol).Value = "Aufwand/Summe: "
' Cells(irow1 + 1, icol).Value = "Aufwand/Summe: "
' Cells(irow1 + 1, icol).Value = "Start: "
' Cells(irow1 + 2, icol).Value = "Ende: "
' Cells(irow1 + 3, icol).Value = "Verantw: "
' icol = 17
' Next irow1
' Next irow
'
''Wrap and Font for all
'
' With Range("O12:V13,Q20:X21,Q27:X28,Q34:X35,Q41:X42,O14:V14,O15:V15,O16:V16," & _
' "O17:V17,Q41:X42,Q22:X22,Q23:X23,Q24:X24,Q25:X25,Q30:X30,Q31:X31,Q32:X32," & _
' "Q38:X38,Q39:X39,Q41:X42,Q46:X46,Q29:X29,Q36:X36,Q43:X43,Q37:X37,Q44:X44,Q45:X45")
' .WrapText = True
' .Name = "TKTypeRegular"
' .Font.Size = 9
' .VerticalAlignment = xlTop
' End With

End Sub

再次感谢您的帮助。

Answer 1

我很难理解你要在这里完成的工作。基于我能理解的是你有这行代码：

Range("O12:V13,O14:V14,O15:V15,O16:V16,O17:V17").Select

你从录制宏中获得的。您希望能够选择其他列和范围，而不是仅限于“O”和“V”列。

VBA：创建具有级别的变量块

1 个答案: