Question

我决定尝试使我的许多Office任务之一自动执行！我的任务是将html文档（具有约30行和25行的表）导入到我的工作簿中，然后在删除导入的文档之前将一些值复制到“统计信息”中。到目前为止，导入文档效果很好。我的问题是，当我进入计算该行百分比贡献的过程时，代码停止了，方法是将第20行的每个列值除以其行总数，然后将列总数除以总计。我要复制到输出工作表中的数字是各行对第20行和“总计”行的百分比贡献分布。然后我将在每个新月重复一次，同时在输出表中保留历史记录。

当我到达该行时，代码会停止

dateOutPutRange.Cells(counter + 1, columnnumber).Value = Replace  (lipfRange.Offset(0, kolonne.Column), " ", "") / lipfTotalValue

和

dateOutPutRange.Offset(10, 0).Cells(counter + 1, columnnumber).Value = Replace(totalRange.Offset(0, kolonne.Column), " ", "") / marketTotalValue

我将在下面添加我的代码。这对任何人有意义吗？是容易发现我的错误，还是必须重建整个shebang？

Sub format_data()

Dim dataSheet As Worksheet
Set dataSheet = Worksheets(ThisWorkbook.Sheets.Count)

Dim outputSheet As Worksheet
Set outputSheet = Worksheets("Statistics")

Dim dataDate As Date
'get date
dataDate = DateValue(Right(dataSheet.Name, 10))
dataDate = DateSerial(Year(dataDate), Month(dataDate), 1)

Dim lipfRange As Range
Dim totalRange As Range

'Find the position of the two categories we want
Set lipfRange = dataSheet.Range("A:A").Find("Li and PF")
Set totalRange = dataSheet.Range("A:A").Find("TOTALSUM")

'Outputrange of dates
Dim dateOutPutRange As Range
Set dateOutPutRange = outputSheet.Range("B4", outputSheet.Range("B4").End(xlToRight))

'Find the total lenght of the table (totalsum row)
Dim groupRange As Range
Set groupRange = dataSheet.Range(totalRange, totalRange.End(xlToRight))

'Find witch column the current date is placed
columnnumber = Application.Match(CLng(dataDate), dateOutPutRange, 0)


Dim counter As Integer

counter = 1

'Find and format the total value to divide with
Dim lipfTotalValue As Variant
Dim marketTotalValue As Variant

lipfTotalValue = Replace(lipfRange.Offset(0, groupRange.Count -   2).Value, " ", "")
marketTotalValue = Replace(totalRange.Offset(0, groupRange.Count - 2).Value, " ", "")



For Each kolonne In groupRange.Columns
If totalRange.Offset(0, kolonne.Column).Value <> 100 And totalRange.Offset(0, kolonne.Column).Value <> "" Then

'Li and PF
dateOutPutRange.Cells(counter + 1, columnnumber).Value = Replace(lipfRange.Offset(0, kolonne.Column), " ", "") / lipfTotalValue

'Total
dateOutPutRange.Offset(10, 0).Cells(counter + 1, columnnumber).Value = Replace(totalRange.Offset(0, kolonne.Column), " ", "") / marketTotalValue

counter = counter + 1
End If


Next
'Delete working sheet from workbook - values are now imported into the totalSheet
If ThisWorkbook.Sheets(1).Name <> "Statistics" Then
Application.DisplayAlerts = False
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Delete
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True

End Sub

感谢您的阅读！

使用VBA从html文档计算并复制到excel工作表：运行时错误13类型不匹配

0 个答案: