joi, 24 octombrie 2019

The Zig-Zag Problem - VBA Excel


https://www.geeksforgeeks.org/print-matrix-zag-zag-fashion/


La aceasta adresa am gasit o problema interesanta.
Pagina ofera solutii in C++, Java, Python3, C# si PHP. Eu voi oferi o solutie Vizual Basic cu ceva animatie intr-un sheet Excel.

I found an interesting problem at the address above.
The web page offers C++, Java, Python3, C# and PHP solutions. Here I offer a Visual Basic solution with a minimum Excel sheet animation. 

Intai, construiti un buton undeva in sheet-ul activ.

Insert a button somewhere into active sheet, first. 






Deschideti editorul Visual Basic si construiti un formular ca cel din imaginea de mai jos.
Open the Visual Basic editor and insert a form as in picture below: 





Codul se afla in modulul formularului frmZigZag si este urmatorul / The Visual Basic code will follow in frmZigZag form module:



'source code: https://code-for-vb.blogspot.com/2019/10/the-zig-zag-problem-vba-excel.html

'please to mention


Option Explicit


Private Sub cmdCancel_Click()
    End
End Sub

Private Sub cmdOK_Click()
    If Me!txtRanduri.Value = 0 Or IsNull(Me!txtRanduri) Or Me!txtRanduri = "" Then
       MsgBox "You have to input a rows number.", vbInformation, "Zig Zag"
       Me!txtRanduri.SetFocus
       Exit Sub
    End If
    If Me!txtColoane.Value = 0 Or IsNull(Me!txtColoane) Or Me!txtColoane = "" Then
       MsgBox "You have to input a columns number.", vbInformation, "Zig Zag"
       Me!txtColoane.SetFocus
       Exit Sub
    End If

    ZigZag
End Sub

Private Sub ZigZag()
    Dim nRow As Integer, nCol As Integer
    Dim r As Integer, c As Integer, k As Integer
    Dim Go As String
    Dim objCel As Object, Final As String


    nRow = Me!txtRanduri
    nCol = Me!txtColoane


    Me.Hide

    For r = 1 To nRow
        For c = 1 To nCol
            k = k + 1
            ActiveSheet.Cells(r, c) = k
            Application.Wait Now + TimeValue("0:00:01")
        Next c
    Next r

    Range(Cells(1, 1), Cells(nRow, nCol)).EntireColumn.AutoFit
    Application.Wait Now + TimeValue("0:00:01")


    r = 1
    c = 1
    Cells(r, c).Select

    Set objCel = ActiveCell
    objCel.Font.Bold = True
    objCel.Font.Color = -16776961

    Final = objCel.Value
    Application.Wait Now + TimeValue("0:00:01")

    Go = "up"
    Do
      Select Case Go
      Case "up"
           c = c + 1
           r = r - 1
           If r < 1 Then
              r = 1
              Go = "down"
           End If
       
      Case "down"
           r = r + 1
           c = c - 1
           If c < 1 Then
              c = 1
              Go = "up"
           End If
      End Select
   
  
      Cells(r, c).Select
      objCel.Font.Bold = False
      objCel.Font.Color = 0
  
      Set objCel = ActiveCell
      objCel.Font.Bold = True
      objCel.Font.Color = -16776961
  
      Final = Final & "," & objCel.Value
      Application.Wait Now + TimeValue("0:00:01")
  
      If r = nRow And c = nCol Then Exit Do
  
  
      Select Case Go
      Case "up"
           If c = nCol Then
              c = c + 1
              Go = "down"
           End If
       
      Case "down"
           If r = nRow Then
              r = r + 1
              Go = "up"
           End If
      End Select
    Loop Until r >= nRow And c >= nCol

    Cells(nRow + 2, 1).Select
    objCel.Font.Bold = False
    objCel.Font.Color = 0

    Set objCel = ActiveCell
    objCel.Font.Bold = True
    objCel.Font.Color = -16776961

    objCel.Value = Final
    MsgBox "Final!", vbInformation, "Zig Zag"

    End
End Sub

Private Sub lblColoane_Click()
    Me!txtColoane.SetFocus
End Sub

Private Sub lblRanduri_Click()
    Me!txtRanduri.SetFocus
End Sub

Private Sub txtColoane_AfterUpdate()
    Me!txtColoane = Int(Abs(Me!txtColoane))
End Sub

Private Sub txtRanduri_AfterUpdate()
    Me!txtRanduri = Int(Abs(Me!txtRanduri))
End Sub



'Construiti un modul separat pentru codul care va activa butonul din sheetul activ si legati codul de acest buton / Insert a separate module for the code for button in active sheet and link the code with the button event.


Option Explicit

Sub Button1_Click()
    frmZigZag.Show
End Sub


'Rularea programului / Running the code:





'Rezultatul / The result:









Niciun comentariu:

Trimiteți un comentariu