咔片PPT · AI自动生成演示文稿,模板丰富、排版精美 讯飞智文 · 一键生成PPT和Word,高效应对学习与办公



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