Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek dla www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

Excel, mam problem! Pomóżcie

12 Lis 2010 23:32 1106 7
  • Poziom 9  
    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?

    Code:
    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.
    Code:
    .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
    Code:
    .tabl(i, j).Interior.ColorIndex = xlNone
  • Poziom 24  
    A gdzie jest
    Application.ScreenUpdating = True ?
  • Poziom 9  
    Powinno być na końcu, ale po dodaniu wszystko jest tak samo. Wykonuje komórka po komórce:(
  • Poziom 24  
    Jeżeli odświeżanie ekaranu jest wyłączone przed dokonaniem obliczeń i włączone po zakończeniu, to makro powinno wykonywać się szybko.
  • Poziom 9  
    Powinno, ale niestety w tym przypadku mi sie to nie sprawdza. Szukam przyczyny i nie mogę tego ogarnąć.
  • Moderator Programowanie
    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:
    Code:
    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?
    Code:
    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.
  • Poziom 9  
    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.
  • Moderator Programowanie
    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ź
    Code:
    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.