首页 两轮车 三轮车 汽车 头条 报价 推荐 资讯 焦点 品牌 技术
首页 >  焦点 > 

【实例07-根据模版生成数据】Excel表格VBA编程实例 代码分享

2023-02-25 01:05:15 来源:哔哩哔哩

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

关键词: 操作界面 处理完成

下一篇:
上一篇:

相关新闻