logo elektroda
logo elektroda
X
logo elektroda
Szukanie Zaawansowane
logo elektroda
REKLAMA
REKLAMA
Adblock/uBlockOrigin/AdGuard mogą powodować znikanie niektórych postów z powodu nowej reguły.

Jak przyspieszyć działanie makra w Excelu do zmiany wartości komórek?

red_zin 12 Lis 2010 23:32 1322 7
REKLAMA
Zgłoś naruszenie prawa
Odpowiedz | Nowy temat
  • #1 8736623
    red_zin
    Poziom 10  
    Posty: 6
    Ocena: 14
    Mam problem. Mianowicie kod, który zaraz wkleje liczy liczbę sąsiadów komórek, w których są jedynki. W zależności ile tych komórek o wartości jeden jest u sąsiadów to dana komórka albo zmienia wartosć na 1(gdy jest 3 sąsiadów itp.) lub zmienia na 0 lub pozostaje przy swojej poprzedniej wartości. Gdy zmieni wartosć na 1 to automatycznie komórka zmieni kolor na czarny, a gdy ma wartosc 0 to bez koloru. Ogólnie problem tkwi w tym, że makro wykonuje się komórka po komórce i to trwa zdecydowanie za długo, jak zrobić żeby przeliczyło od razu wszystkie komórki?

    Kod: text Rozwiń Zaznacz wszystko Kopiuj do schowka
    Dim i As Variant, j As Variant, tabl

If UserForm1.TextBox1.Value = 1 Then 'jesli tylko jedno przejscie planszy(jedna petla)

With UserForm1.Spreadsheet1.Worksheets(1)
tabl = .Range(.Cells(2, 2), .Cells(53, 53))
Application.ScreenUpdating = False
For i = 2 To 50
For j = 2 To 50
If tabl(i, j) = 1 Then
If tabl(i - 1, j) + tabl(i - 1, j - 1) + tabl(i - 1, j + 1) + _
tabl(i, j + 1) + tabl(i + 1, j + 1) + tabl(i + 1, j) + _
tabl(i + 1, j - 1) + tabl(i, j - 1) = 3 _
Or tabl(i - 1, j) + tabl(i - 1, j - 1) + tabl(i - 1, j + 1) + _
tabl(i, j + 1) + tabl(i + 1, j + 1) + tabl(i + 1, j) + _
tabl(i + 1, j - 1) + tabl(i, j - 1) = 2 Then
tabl(i, j) = 1
.Cells(i, j).Interior.ColorIndex = 1

Else
tabl(i, j) = 0
.Cells(i, j).Interior.ColorIndex = xlNone

End If
Else
If tabl(i - 1, j) + tabl(i - 1, j - 1) + tabl(i - 1, j + 1) + tabl(i, j + 1) _
+ tabl(i + 1, j + 1) + tabl(i + 1, j) + tabl(i + 1, j - 1) + tabl(i, j - 1) = 3 Then
tabl(i, j) = 1

.Cells(i, j).Interior.ColorIndex = 1

Else
tabl(i, j) = 0

.Cells(i, j).Interior.ColorIndex = xlNone

End If
End If
Next j
Next i
.Range(.Cells(1, 1), .Cells(51, 51)) = tabl

End With


    Problem chyba tkwi w tej zmianie koloru, bo jak go usuniemy z kodu to makro wykonuje się tak szybko jak powinno.
    Kod: text Rozwiń Zaznacz wszystko Kopiuj do schowka
    .Cells(i, j).Interior.ColorIndex = xlNone

    index koloru nie należy do tablicy tabl, jak go tam umieścić?
    próbowałem coś takiego, ale nie da się, wyskakuje błąd
    Kod: text Rozwiń Zaznacz wszystko Kopiuj do schowka
    .tabl(i, j).Interior.ColorIndex = xlNone
  • REKLAMA
  • REKLAMA
  • #3 8736666
    red_zin
    Poziom 10  
    Posty: 6
    Ocena: 14
    Powinno być na końcu, ale po dodaniu wszystko jest tak samo. Wykonuje komórka po komórce:(
  • #4 8736693
    fascynat
    Poziom 24  
    Posty: 737
    Pomógł: 64
    Ocena: 107
    Jeżeli odświeżanie ekaranu jest wyłączone przed dokonaniem obliczeń i włączone po zakończeniu, to makro powinno wykonywać się szybko.
  • REKLAMA
  • #5 8736712
    red_zin
    Poziom 10  
    Posty: 6
    Ocena: 14
    Powinno, ale niestety w tym przypadku mi sie to nie sprawdza. Szukam przyczyny i nie mogę tego ogarnąć.
  • REKLAMA
  • #6 8737032
    adamas_nt
    VIP Zasłużony dla elektroda  
    Posty: 5320
    Pomógł: 1508
    Ocena: 658
    1. Odświeżanie ekranu koniecznie włącz na końcu.
    2. Skąd uruchamiasz makro? Prawidłowo: procedura w module, z formularza wywołanie (mowa o Excelu, czy arkuszu Excela w VB?)
    3. Deklaracje:
    Kod: text Rozwiń Zaznacz wszystko Kopiuj do schowka
    Dim i As Integer, j As Integer, tabl As Variant

    4. Coś mi tu nie gra. Za dużo tych warunków (liczenia w związku z tym), albo czegoś nie dopowiedziałeś...
    5. Dlaczego tak?
    Kod: text Rozwiń Zaznacz wszystko Kopiuj do schowka
    tabl = .Range(.Cells(2, 2), .Cells(53, 53))
(...)
.Range(.Cells(1, 1), .Cells(51, 51)) = tabl


    Jeśli tabela jest zero-jedynkowa lub można doszukać się jakiś reguł, to rozważ formatowanie warunkowe w arkuszu, niezależnie od makra.
  • #7 8737586
    red_zin
    Poziom 10  
    Posty: 6
    Ocena: 14
    Faktycznie opowiedziałem w dużym skrócie. Inne makro podłączone do buttona mam na wypisywanie losowo liczb w zakresie. Po wypisaniu tych liczb włączam te które wkleiłem. Warunki wszystkie muszą być. Każda komórka ma 8 sąsiadów, dlatego na każdy warunek składa się 8 składowych tego warunku(nie wiem jak to sie nazywa fachowo). Ten pierwszy warunek jest niepotrzebny, ten do którego dodałem komentarz.
    To o co pytasz:

    tabl = .Range(.Cells(2, 2), .Cells(53, 53))

    jest to deklaracja i zakres tablicy
    a to:

    .Range(.Cells(1, 1), .Cells(51, 51)) = tabl

    po wykonaniu pętli po prostu wypisuje w tym zakresie wynik, który był przechowywany w tablicach. Zależy mi na tym żeby wszystko było na makrach.
  • #8 8738031
    adamas_nt
    VIP Zasłużony dla elektroda  
    Posty: 5320
    Pomógł: 1508
    Ocena: 658
    Ale dlaczego tak?
    1. Rozmiary różnią się o 1.
    2. Przesuwasz tabelę o 1 w lewo i 1 w górę.
    Dwa skrajne wiersze i dwie skrajne kolumny zostają nienadpisane. Chyba, że tak ma być.

    Sprawdź
    Kod: text Rozwiń Zaznacz wszystko Kopiuj do schowka
    Dim i As Integer, j As Integer, tabl As Variant
Dim wynik As Long

If UserForm1.TextBox1.Value = 1 Then 'jesli tylko jedno przejscie planszy(jedna petla)

  With UserForm1.Spreadsheet1.Worksheets(1)
    With Application
      .ScreenUpdating = False
      .EnableEvents = False
    End With
    
    tabl = .Range(.Cells(2, 2), .Cells(53, 53))
    Application.ScreenUpdating = False
    For i = 2 To 50
      For j = 2 To 50
        wynik = tabl(i - 1, j) + tabl(i - 1, j - 1) + tabl(i - 1, j + 1) + _
        tabl(i, j + 1) + tabl(i + 1, j + 1) + tabl(i + 1, j) + _
        tabl(i + 1, j - 1) + tabl(i, j - 1)
        Select Case tabl(i, j)
          Case 1
            Select Case wynik
              Case 2 To 3
                'tabl(i, j)=1  ' tu ma już wartość 1
                .Cells(i, j).Interior.ColorIndex = 1
              Case Else
                tabl(i, j) = 0
                .Cells(i, j).Interior.ColorIndex = xlNone
            End Select
          Case Else
            If wynik = 3 Then
              tabl(i, j) = 1
              .Cells(i, j).Interior.ColorIndex = 1
            Else
              tabl(i, j) = 0
              .Cells(i, j).Interior.ColorIndex = xlNone
            End If
        End Select
      Next j
    Next i
    .Range(.Cells(1, 1), .Cells(51, 51)) = tabl
    With Application
      .ScreenUpdating = True
      .EnableEvents = True
    End With
  End With
End If
    W przykładzie makro liczy tylko raz, porównuje wartości i wybiera właściwą akcję, więc powinno działać szybciej.
    Możliwe, że gdzieś się pomyliłem, ale przede wszystkim chodzi tu o pokazanie schematu działania.


    Dodano po chwili: Sprawdziłem Timer'em przy pustym arkuszu. Wynik (zokrąglony do 4 mpp) 0,4844:0,2852 na korzyść Select Case.
Odpowiedz | Nowy temat
Zgłoś naruszenie prawa

Podsumowanie tematu

✨ Użytkownik ma problem z wydajnością makra w Excelu, które oblicza liczbę sąsiadów komórek z wartością 1. Makro działa wolno, przetwarzając komórki pojedynczo. Uczestnicy dyskusji sugerują, aby wyłączyć odświeżanie ekranu przed obliczeniami i włączyć je po zakończeniu, co powinno przyspieszyć działanie. Zwracają również uwagę na poprawność deklaracji zmiennych oraz na konieczność sprawdzenia zakresu tablicy. Użytkownik wyjaśnia, że makro jest uruchamiane z formularza i że wszystkie warunki muszą być spełnione, co komplikuje kod. Proponowane są również zmiany w logice obliczeń oraz rozważenie użycia formatowania warunkowego.
Wygenerowane przez model językowy.
REKLAMA