我有用于从加热/冷冻室选择温度范围的代码(值在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
有时宏会绘制图表....有时不会。