Normalizing Fields - VBA Access

MS Access permite campuri cu valori multiple, ceea ce nu este intotdeauna potrivit. In cazul in care tabelele nu sunt folosite ca atare, pentru programator nu este nici un avantaj sa aiba campuri cu valori multiple. Tot ceea ce are de facut, este sa normalizeze datele prin atomizarea campurilor.

MS Access allows multiple values fields, which is not always appropriate. If the tables are not used as it is, there is no advantage for the programmer to having fields with multiple values. All he has to do is normalize the data by atomizing the fields.


De exemplu, avem un tabel unde codificam grupurile de utilizatori.

For example, we have a table where we code the users groups.

Si un tabel cu utilizatori si grupurile din care fac parte. Un utilizator poate face parte din mai multe grupuri.

And a table with users and the groups they belong to. A user may be part of several groups.

Sursa campului GroupID arata astfel:

The source of the GroupID field looks like this:

Pentru atomizare, folositi acest cod:

For atomization, use this code:


'source:  https://code-for-vb.blogspot.com/2019/10/normalizing-fields-vba-access.html
'please to mention

Sub ColumnsAtomization()
  Dim rst_1 As Recordset
  Dim rst_2 As Recordset
  Dim str() As String
  Dim aaa   As String
  Dim i     As Integer


  CurrentDb.Execute "CREATE TABLE [Users_New] (UserID INTEGER, UserName TEXT(20), GroupID INTEGER)"
  
  Set rst_2 = CurrentDb.OpenRecordset("Users_New")
  Set rst_1 = CurrentDb.OpenRecordset("Users")
  Do
    aaa = DLookup("GroupID", "Users", "UserID = " & rst_1!UserID)
    str = Split(aaa, ", ") 'or  str = Split(aaa, "; ") - depends on regional settings
    For i = 0 To UBound(str)
        rst_2.AddNew
        rst_2!UserID = rst_1!UserID
        rst_2!UserName = rst_1!UserName
        rst_2!GroupID = str(i)
        rst_2.Update
    Next i
  
    rst_1.MoveNext
  Loop Until rst_1.EOF = True

  Set rst_1 = Nothing
  Set rst_2 = Nothing
End Sub

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:

Sorting & Grouping Vectors - VBA

'*****************************************************************
'Urmatorul cod va face:                                          *
'                                                                *
'1.Ordoneaza vectorul                                            *  
'2.Numara grupurile de valori ale vectorului                     *
'3.Calculeaza frecventa de aparitie a fiecarei valori din grup   *
'4.Ordoneaza frecventele de aparitie a valorilor vectorului      *
'5.Grupeaza frecventele de aparitie                              *
'6.Identifica un numar in ce grupa de frecvente se afla          *

'*****************************************************************

'*****************************************************************
'The following code will do:                                     *
'                                                                *
'1.Sort the vector                                               *  
'2.Number the groups of values of the vector                     *
'3.Count the frequency of occurrence of each value in the group  *
'4.Sort the frequencies of the vector values                     *
'5.Group the occurrence frequencies                              *
'6.Identify a number in which frequency group it is              *

'*****************************************************************

'source: https://code-for-vb.blogspot.com/2019/10/sorting-grouping-vectors-vba.html
'please to mention

Option Compare Database
Option Explicit

Private V() As Integer, VRez() As Integer
Private Nr  As Integer, NrGr   As Integer


Sub PornesteVector()
    Nr = InputBox("Introduceti numarul / Input number")
    CheamaVectorSort
End Sub

Sub CheamaVectorSort()
    Dim j          As Integer
    Dim strIni     As String 'acesta este sirul pe care il voi ordona / this is the string I want to sort
    Dim strSplit() As String

    strIni = "-1;4;-1;4;-7;-1;-7;-1;-5;-7;8"
    strSplit = Split(strIni, ";")

    ReDim V(UBound(strSplit)), VRez(UBound(strSplit))
    For j = LBound(strSplit) To UBound(strSplit)
        V(j) = strSplit(j)
        Debug.Print "V(" & j & ") = " & V(j)
    Next j

    For j = LBound(V) To UBound(V) - 1
        VectorSort
    Next j

    Debug.Print "sortez valorile vectorului / sort the vector values:"
    For j = LBound(V) To UBound(V)
        Debug.Print "V(" & j & ") = " & V(j)
        VRez(j) = V(j)
    Next j

    GrupuriV
End Sub

Sub VectorSort()
    Dim a, b, c, d, e
    Dim i As Integer
    Dim VN() As Integer

    ReDim VN(LBound(V) To UBound(V))
    'la prima iteratie compar primele doua valori ale vectorului V
    'inmagazinez valoarea mai mare intr-o variabila fixa (d)
    'si de la a doua iteratie, compar valoarea vectorului V cu valoarea reziduala d
    'la final, trec valorile vectorului nou VN ca valori ale vectorului V

    'at the first iteration I compare the first two values of the vector V
    'store the higher value in a fixed variable (d)
    'and from the second iteration, I compare the value of vector V with the residual value d
    'at the end, pass the values of the new vector VN as values of the vector V

    e = 0
    For i = LBound(V) + 1 To UBound(V)
        e = e + 1
    
        a = V(i)
        If e = 1 Then
           b = V(i - 1)
        Else
            b = d
        End If
    
        If a > b Then
           c = b
           VN(i) = a
        Else
            c = a
            VN(i) = b
        End If
    
        VN(i - 1) = c
        d = VN(i)
    Next i

    For i = LBound(V) To UBound(V)
        V(i) = VN(i)
    Next i
End Sub

Sub GrupuriV()
    Dim k As Integer, gr() As Integer, i As Integer, fr() As Integer, j As Integer
    Dim a As Byte

    Do
      k = 1
      For i = LBound(V) + 1 To UBound(V)
          If V(i) > V(i - 1) Then
             k = k + 1
          End If
      Next i

      Debug.Print k; "grupuri / groups"
      NrGr = k
  
      ReDim gr(k), fr(k)
      k = 1
      gr(1) = V(LBound(V))
      fr(k) = 1
      j = 1
  
      For i = LBound(V) + 1 To UBound(V)
          If V(i) > V(i - 1) Then
             k = k + 1
             j = 1
          Else
              j = j + 1
          End If
          gr(k) = V(i)
          fr(k) = j
      Next i

      Select Case a
      Case 0
           For i = 1 To k
               Debug.Print "gr(" & i & ") = " & gr(i), "freq(" & i & ") = " & fr(i)
           Next i

           ReDim V(k - 1)
           For i = 1 To k
               V(i - 1) = fr(i)
           Next i
       
           Debug.Print "sortez frecventele / sort the frequencies:"
           For i = LBound(V) To UBound(V) - 1
               VectorSort
           Next i
           For i = LBound(V) To UBound(V)
               Debug.Print "V(freq(" & i & ")) = " & V(i)
           Next i
  
      Case Else
           For i = 1 To k
               Debug.Print "gr(" & i & ") = " & gr(i)
           Next i
      End Select
  
      a = a + 1
    Loop Until a = 2

    ApartineV
End Sub

Sub ApartineV()
    Dim i As Integer, a As Integer

    For i = LBound(VRez) To UBound(VRez)
        If Nr = VRez(i) Then
           a = a + 1
        End If
    Next i

    Debug.Print "nr. " & Nr & " apartine gr. " & a & " din " & NrGr
    Debug.Print "no. " & Nr & " belong to gr. " & a & " from " & NrGr
End Sub

'Sa presupunem ca numarul introdus este 8 / Assume that the input number is 8.
'Rezultatul / The result:

V(0) = -1
V(1) = 4
V(2) = -1
V(3) = 4
V(4) = -7
V(5) = -1
V(6) = -7
V(7) = -1
V(8) = -5
V(9) = -7
V(10) = 8
sortez valorile vectorului / sort the vector values:
V(0) = -7
V(1) = -7
V(2) = -7
V(3) = -5
V(4) = -1
V(5) = -1
V(6) = -1
V(7) = -1
V(8) = 4
V(9) = 4
V(10) = 8
 5 grupuri / groups
gr(1) = -7    freq(1) = 3
gr(2) = -5    freq(2) = 1
gr(3) = -1    freq(3) = 4
gr(4) = 4     freq(4) = 2
gr(5) = 8     freq(5) = 1
sortez frecventele / sort the frequencies:
V(freq(0)) = 1
V(freq(1)) = 1
V(freq(2)) = 2
V(freq(3)) = 3
V(freq(4)) = 4
 4 grupuri / groups
gr(1) = 1
gr(2) = 2
gr(3) = 3
gr(4) = 4
nr. 8 apartine gr. 1 din 4
no. 8 belong to gr. 1 in 4