【实例07-根据模版生成数据】Excel表格VBA编程实例 代码分享
Private Sub CommandButton生成_Click()
'清空生成结果
With ThisWorkbook.Worksheets("生成结果")
.UsedRange.ClearFormats
.UsedRange.ClearContents
End With
With ThisWorkbook.Worksheets("临时表")
.UsedRange.ClearFormats
.UsedRange.ClearContents
End With
'将模版复制到临时表
Dim modelrange As String
With ThisWorkbook.Worksheets("操作界面")
If Trim(.Cells(2, "C").Value) <> "" Then
modelrange = Trim(.Cells(2, "C").Value)
End If
End With
With ThisWorkbook.Worksheets("模版")
Dim addmodeladdress As String
addmodeladdress = .Range(modelrange).Cells(1).Address
.Range(modelrange).Copy ThisWorkbook.Worksheets("临时表").Range(addmodeladdress)
End With
'循环填充数据
With ThisWorkbook.Worksheets("数据列表")
Dim i, imax, j, jmax
imax = .Cells(1000000, 1).End(xlUp).Row
jmax = .Cells(1, 1000).End(xlToLeft).Column
If i = 1 Then
Exit Sub
End If
Dim rmax As Long '生成结果最大行
For i = 2 To imax
For j = 1 To jmax
If .Cells(1, j) <> "" Then
If .Cells(i, j).Value <> "" Then
ThisWorkbook.Worksheets("临时表").Range(CStr(.Cells(1, j))).Value = .Cells(i, j).Value
Else
ThisWorkbook.Worksheets("临时表").Range(CStr(.Cells(1, j))).Value = ""
End If
End If
Next j
'循环一行，就将结果复制到生成结果表
If i = 2 Then
ThisWorkbook.Worksheets("临时表").Range(modelrange).Copy ThisWorkbook.Worksheets("生成结果").Cells(1, 1)
Else
rmax = ThisWorkbook.Worksheets("生成结果").UsedRange.Cells(ThisWorkbook.Worksheets("生成结果").UsedRange.Count).Row
ThisWorkbook.Worksheets("临时表").Range(modelrange).Copy ThisWorkbook.Worksheets("生成结果").Cells(rmax + 1, 1)
End If
Next i
End With
'处理完成跳转到生成结果表
ThisWorkbook.Worksheets("生成结果").Activate
End Sub
