从关闭的工作簿单元格中获取数据类型并相应地改变操作

时间:2018-03-03 12:22:19

标签: excel vba excel-vba

我在一个概述表中从许多不同的工作表中收集度量值,这些工作表将用于生成PowerBI仪表板。

下面是我的代码,我是vba的新手,所以它可能不那么优雅,但除了一件事之外,它可以满足我的需求。

这些工作表中的某些指标值是整数,其他指标具有数据类型百分比。 如果度量标准表中的值具有数字格式%,例如格式为%的“10”,则使用当前代码将其视为0,1。我想将这些百分比乘以100,并在概览表中添加此数字。但是我很难找到如何提取数据类型,如果百分比,则乘以100,如果没有百分比,则按原样获取值。有人能帮忙吗?

非常感谢 -

Function HasSheet(fPath As String, fName As String, sheetName As String)
On Error Resume Next
Dim f As String

f = "'" & fPath & "[" & fName & "]" & sheetName & "'!R1C1"

HasSheet = Not IsError(Application.ExecuteExcel4Macro(f))
If Err.Number <> 0 Then
    HasSheet = False
End If
On Error GoTo 0
End Function


Sub CollectMetrics()

Dim id As Integer
Dim Ind As String

Dim MetricName As String
Dim Include1 As String
Dim Include2 As String

Dim Segment As String
Dim file As String
Dim filepath As String
Dim filename As String
Dim s As Boolean

Dim D As Date
Dim MonthNbr As Integer

Set sh1 = Worksheets("Metrics")
Set sh2 = Worksheets("Metadata")


NumRows = sh1.Range("A1", sh1.Range("A1").End(xlDown)).Rows.Count

    For id = 2 To NumRows

        MetricName = sh1.Range("A" & id).Value
        Include1 = Application.WorksheetFunction.VLookup(MetricName, sh2.Range("B2:L100"), 9, True)
        Include2 = Application.WorksheetFunction.VLookup(MetricName, sh2.Range("B2:L100"), 10, True)
        Ind = Application.WorksheetFunction.VLookup(MetricName, sh2.Range("B2:L100"), 2, True)
        filename = Ind & " " & MetricName & " 2018.xlsx"

        If Include1 = "auto" And Include2 = "yes" Then

                 Segment = sh1.Range("B" & id).Value

                 file = "='https://xxx/[" & filename & "]" & Segment
                 filepath = "https://xxx/"


                 s = HasSheet(filepath, filename, Segment)

                        If s Then

                             D = sh1.Range("C" & id).Value
                             MonthNbr = Month(D)

                             sh1.Range("D" & id).Value = file & "'!D" & (MonthNbr + 13)
                             sh1.Range("E" & id).Value = file & "'!E" & (MonthNbr + 13)
                             sh1.Range("F" & id).Value = file & "'!F" & (MonthNbr + 13)
                             sh1.Range("G" & id).Value = file & "'!G" & (MonthNbr + 13)
                             sh1.Range("J" & id).Value = file & "'!D" & (MonthNbr + 40)
                             sh1.Range("K" & id).Value = file & "'!E" & (MonthNbr + 40)
                             sh1.Range("L" & id).Value = file & "'!F" & (MonthNbr + 40)
                             sh1.Range("M" & id).Value = file & "'!G" & (MonthNbr + 40)
                             sh1.Range("O" & id).Value = "values updated on " & Format(Now(), "dd-mm-yy")
                         Else
                             sh1.Range("O" & id).Value = "sheet available but segment missing"
                        End If
                ElseIf Include2 = "no" Then
                 sh1.Range("O" & id).Value = "metric set to not yet include"
                ElseIf Include1 = "manual" Then
                 sh1.Range("O" & id).Value = "metric to be manually updated"
             End If

    Next
MsgBox (" Update completed! ")
End Sub

2 个答案:

答案 0 :(得分:0)

我会尽量避免将百分比乘以100并添加百分比符号,如果有选择的话,可以选择&#34;正确方式&#34;。

在这种情况下,这不是一个大问题,创造良好习惯会更好。 (仅作为记录,10%被视为0,1的原因是因为 10% 0,1

尽管如此,我们需要一种简单的方法将其显示为百分比而不是1的一小部分(如果适用),并且与Excel中的许多任务一样,有多种方法可以完成同样的事情。

这种方式让我误以为:

Range("B1") = Range("A1") 'copies the value
Range("B1").NumberFormat = Range("A1") .NumberFormat 'copies the number format.

我所做的更改:

  • &#34;最干净的&#34;这样做的方法是使用一个名为copyNumber的小子并调整受影响的线以使用新程序。

  • 我整理了缩进 - 对于组织和可读性非常重要。

  • 我添加Option Explicit,这是一个好主意,在每个模块的开头都有,以帮助识别疏忽,例如......

  • sh1sh2未被声明为Worksheet,因此我为其添加了Dim条款 - 但将它们压缩到与其共享的一行上{ {1}} Set冒号的语句。

我所做的其他改变纯粹是装饰性的,更多的是一种推理,显然如果你不喜欢这些改变,就不要使用它们。 :-)

  • 我摆脱了: - 我不喜欢他们,因为缩进很重要。

  • 我使用With..End语句删除重复的代码(例如ElseIfSh1.

  • 我从&#34;页面&#34;中压缩了变量声明(Application.WorksheetFunction.语句)。分为3行。

调整后的代码:

Dim

答案 1 :(得分:0)

以防有人在将来寻找这种方法,这是我使用的最终代码:

    Option Explicit

Function HasSheet(fPath As String, fName As String, sheetName As String)
    On Error Resume Next
    Dim f As String
    f = "'" & fPath & "[" & fName & "]" & sheetName & "'!R1C1"
    HasSheet = Not IsError(Application.ExecuteExcel4Macro(f))
    If Err Then HasSheet = False
    On Error GoTo 0
End Function

Sub CollectMetrics()

    Dim MetricName As String, Segment As String, Ind As String, Include1 As String, Include2 As String, Include3 As String
    Dim file As String, filePath As String, fileName As String
    Dim MonthNbr As Integer, id As Integer, numRows As Integer

    Dim sh1 As Worksheet: Set sh1 = Worksheets("Metrics")
    Dim sh2 As Worksheet: Set sh2 = Worksheets("Metadata")
    With sh1
        numRows = Range("A1", Range("A1").End(xlDown)).Rows.Count

        For id = 2 To numRows
            MetricName = Range("A" & id)
            With Application.WorksheetFunction
                Include1 = .VLookup(MetricName, sh2.Range("B2:L100"), 9, True)
                Include2 = .VLookup(MetricName, sh2.Range("B2:L100"), 10, True)
                Include3 = .VLookup(MetricName, sh2.Range("B2:L100"), 11, True)
                Ind = .VLookup(MetricName, sh2.Range("B2:L100"), 2, True)
            End With
            fileName = Ind & " " & MetricName & " 2018.xlsx"

            If Include1 = "auto" And Include2 = "yes" Then
                Segment = Range("B" & id)

                file = "='https://xxxx/[" & fileName & "]" & Segment
                filePath = "https://xxxx/"

                 If HasSheet(filePath, fileName, Segment) Then

                    MonthNbr = Month(Range("C" & id))

                    sh1.Range("D" & id).Value = file & "'!D" & (MonthNbr + 13)
                    sh1.Range("E" & id).Value = file & "'!E" & (MonthNbr + 13)
                    sh1.Range("F" & id).Value = file & "'!F" & (MonthNbr + 13)
                    sh1.Range("G" & id).Value = file & "'!G" & (MonthNbr + 13)

                    sh1.Range("H" & id).Value = file & "'!B" & (MonthNbr + 13) 'Actuals KPI Index
                        Select Case sh1.Range("H" & id).Value
                        Case "R"
                        sh1.Range("H" & id).Value = "3"
                        Case "Y"
                        sh1.Range("H" & id).Value = "2"
                        Case "G"
                        sh1.Range("H" & id).Value = "1"
                        End Select

                    sh1.Range("I" & id).Value = file & "'!D" & (MonthNbr + 40)
                    sh1.Range("J" & id).Value = file & "'!E" & (MonthNbr + 40)
                    sh1.Range("K" & id).Value = file & "'!F" & (MonthNbr + 40)
                    sh1.Range("L" & id).Value = file & "'!G" & (MonthNbr + 40)

                    sh1.Range("M" & id).Value = file & "'!B" & (MonthNbr + 13) 'YTD KPI Index
                        Select Case sh1.Range("M" & id).Value
                        Case "R"
                        sh1.Range("M" & id).Value = "3"
                        Case "Y"
                        sh1.Range("M" & id).Value = "2"
                        Case "G"
                        sh1.Range("M" & id).Value = "1"
                        End Select

                    Range("N" & id) = "Values updated on " & Format(Now(), "dd-mm-yy")

                    If Include3 = "%" Then              ' multiply with 100 for percentages

                    sh1.Range("D" & id).Value = (sh1.Range("D" & id).Value) * 100
                    sh1.Range("E" & id).Value = (sh1.Range("E" & id).Value) * 100
                    sh1.Range("F" & id).Value = (sh1.Range("F" & id).Value) * 100
                    sh1.Range("G" & id).Value = (sh1.Range("G" & id).Value) * 100
                    sh1.Range("I" & id).Value = (sh1.Range("I" & id).Value) * 100
                    sh1.Range("J" & id).Value = (sh1.Range("J" & id).Value) * 100
                    sh1.Range("K" & id).Value = (sh1.Range("K" & id).Value) * 100
                    sh1.Range("L" & id).Value = (sh1.Range("L" & id).Value) * 100

                    End If
                Else
                    Range("N" & id) = "Sheet available but segment missing"
                End If
            Else
                If Include2 = "no" Then
                    Range("N" & id) = "Metric set to not yet include"
                Else
                    If Include1 = "manual" Then Range("N" & id) = "Metric to be manually updated"
                End If
            End If
        Next id
   End With
    MsgBox "Update completed!"
End Sub
相关问题