Elektroda.pl
Elektroda.pl
X

Search our partners

Find the latest content on electronic components. Datasheets.com
Elektroda.pl
Please add exception to AdBlock for elektroda.pl.
If you watch the ads, you support portal and users.

Excel, mam problem! Pomóżcie

red_zin 12 Nov 2010 23:32 1148 7
  • #1
    red_zin
    Level 10  
    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
    Ethernet jednoparowy (SPE) - rozwiązania w przemyśle. Szkolenie 29.09.2021r. g. 11.00 Zarejestruj się za darmo
  • #2
    fascynat
    Level 24  
    A gdzie jest
    Application.ScreenUpdating = True ?
  • #3
    red_zin
    Level 10  
    Powinno być na końcu, ale po dodaniu wszystko jest tak samo. Wykonuje komórka po komórce:(
  • #4
    fascynat
    Level 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.
  • #5
    red_zin
    Level 10  
    Powinno, ale niestety w tym przypadku mi sie to nie sprawdza. Szukam przyczyny i nie mogę tego ogarnąć.
  • #6
    adamas_nt
    Moderator of Programming
    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.
  • #7
    red_zin
    Level 10  
    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
    adamas_nt
    Moderator of Programming
    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.