宏运行后图表出现问题

时间:2019-02-07 13:21:50

标签: excel vba

我有用于从加热/冷冻室选择温度范围的代码(值在E和F列中,某些情况下在G和H中也是如此)。选定的值将被复制到新的工作表,然后代码将允许从这些值绘制图表。就我而言,有时图表不会出现。我不知道为什么代码为E和F列中的值准备了-这就是为什么某些情况下也要更改为注释以及w = zakres * 2 + 1的原因。对于四列,w = zakres * 4-1。对于这两种情况,我都有同样的问题。

我试图改变桌子的大小,并将箱子分成不同的马科斯。

Sub Wykres()

    Dim w As Long, wrs As Long, i As Long
    Dim dolne As Single, gorne As Single
    Dim ark As String, opis As String, id_zc As String, k As String, pol_wykr As String
    Dim guzik, zakres, czujnik, kol, arr()
    Dim dt As Worksheet, wykr As Object

    On Error GoTo koniec

    With ThisWorkbook
        Set dt = .Sheets("DataChart")

        With .ActiveSheet
            ark = .Name                                     'Przechwycenie nazwy bieżącego arkusza
            guzik = Application.Caller                      'Przechwycenie nazwy wciśniętego przycisku
            opis = .Shapes(guzik).TextFrame.Characters.Text 'Przechwycenie opisu przycisku

            'Podział zmiennej "opis" na części (o indeksach wykazanych w nawiasach)
            ' => "Oblicz(0) zakres(1) 1(2) czujnik(3) 1(4)"
            zakres = Split(opis, " ", -1, 1)(2)             ' => "Oblicz zakres "1"(2) czujnik 1"
            czujnik = Split(opis, " ", -1, 1)(4)            ' => "Oblicz zakres 1 czujnik "1"(4)"

            'Zamiana zawartości zmiennych z tekstu na wartości
            zakres = CInt(zakres)
            czujnik = CInt(czujnik)

            'Wyliczenie wiersza i określenie położenia komórek dla wartości min. i maks. zakresu
            w = zakres * 2 + 1                           'Wiersz danego zakresu Min./Maks.
            dolne = .Range("X" & w).Value               'Ograniczenie dolne
            gorne = .Range("Y" & w).Value               'Ograniczenie górne

            'Określenie kolumny z danymi dla czujnika - założenie takie, że mamy 4 czujniki:
            '1 = "E", 2 = "F", 3 = "G", 4 = "H"
            k = Choose(czujnik, "E", "F", "G", "H")

            'Określenie adresu kotwiczenia dla tworzonego później wykresu
            Select Case zakres & "-" & czujnik
                Case "1-1": pol_wykr = "M10"
                Case "1-2": pol_wykr = "M15"
                'Case "1-3": pol_wykr = "M20"
                'Case "1-4": pol_wykr = "M25"
                Case "2-1": pol_wykr = "M20"
                Case "2-2": pol_wykr = "M25"
                'Case "2-3": pol_wykr = "M40"
                'Case "2-4": pol_wykr = "M45"
                Case "3-1": pol_wykr = "M30"
                Case "3-2": pol_wykr = "M35"
                'Case "3-3": pol_wykr = "M60"
                'Case "3-4": pol_wykr = "M65"
                'Case "4-1": pol_wykr = "M70"
                'Case "4-2": pol_wykr = "M75"
                'Case "4-3": pol_wykr = "M80"
                'Case "4-4": pol_wykr = "M85"
                'Case "5-1": pol_wykr = "M90"
                'Case "5-2": pol_wykr = "M95"
                'Case "5-3": pol_wykr = "M100"
                'Case "5-4": pol_wykr = "M105"
                'Case "6-1": pol_wykr = "M110"
                'Case "6-2": pol_wykr = "M115"
                'Case "6-3": pol_wykr = "M120"
                'Case "6-4": pol_wykr = "M125"
            End Select

            'Arbitralne określenie maks. indeksu tablicy
            'do przechowania danych z pętli "For ... Next",
            'w oparciu o maks. ilość wierszy z danymi dla danego czujnika
            wrs = .Range(k & .Rows.Count).End(xlUp).Row
            ReDim arr(1 To wrs, 1 To 1)                     'Rozmiarowanie tablicy na dane
            w = 0                                           'Indeks właściwy tablicy pokazujący jej prawdziwą zajętość

            For i = 1 To wrs
                If IsNumeric(.Range(k & i).Value) Then      'Tylko wartości numeryczne będą rozpatrywane
                    If .Range(k & i).Value >= dolne And .Range(k & i).Value <= gorne Then 'Kryteria
                        w = w + 1
                        arr(w, 1) = .Range(k & i).Value     'Wpisywanie do tablicy wartości spełniających kryteria
                    End If
                End If
            Next
        End With

        If Not IsEmpty(arr(1, 1)) Then                      'Jeśli choć pierwszy indeks tablicy został zainicjalizowany to ...
            id_zc = "A" & ark & ".Z" & zakres & ".C" & czujnik  'Utwórz identyfikator danych = A24.Z1.C1

            With dt
                kol = Application.Match(id_zc, .Rows("1:1"), 0) 'Wyszukaj id danych w arkuszu "DataChart"

                If TypeName(kol) = "Error" Then                 'Jeśli ich nie znaleziono to
                    kol = Application.CountA(.Range("1:1")) + 1 'Sprawdź ile jest kolumn i zwiększ ich ilość o 1
                Else                                            'W przciwnym razie
                    .Columns(kol).ClearContents                 'Usuń zawartość kolumny o znalezionym id danych
                End If

                .Cells(1, kol).Value = id_zc                    'Wpisz id danych do nagłówka => A24.Z1.C1
                .Cells(2, kol).Resize(wrs, 1).Value = arr       'Wpisz dane z tablicy
                Erase arr                                       'Usuń z tablicy zbędne już dane - zwalnia pamięć

                'Wylicz właściwą ilość danych w kolumnie -
                'tożsame z indeksem "w" z pętli "For ... Next", można stosować zamiennie, nawet wskazane
                wrs = .Cells(.Rows.Count, kol).End(xlUp).Row
            End With

            With .ActiveSheet
                'Sprawdź, czy w konkretnym zakresie kotwiczenia jest już jakiś wykres i jeśli tak, to usuń go
                For Each wykr In .ChartObjects
                    If Not Intersect(wykr.TopLeftCell, .Range(pol_wykr)) Is Nothing Then wykr.Delete
                Next

                With .ChartObjects.Add(Left:=627, Top:=56, Width:=336, Height:=79)
                    'Użyj danych z arkusza "DataChart", jako źródłowych do wykresu
                    .Chart.SetSourceData Source:=dt.Range(Range(Cells(2, kol), Cells(wrs, kol)).Address(0, 0))
                    .Chart.ChartType = xlLine

                    'Pozycjonowanie wykresu w oparciu o określony wcześniej adres kotwiczenia
                    .Left = .Parent.Range(pol_wykr).Left
                    .Top = .Parent.Range(pol_wykr).Top
                End With

                .Range("K2").Select
            End With
        End If

        Set dt = Nothing
    End With

有时宏会绘制图表....有时不会。

0 个答案:

没有答案