Új hozzászólás Aktív témák

• #47066 szricsi_0917 tag Delila_1 #47045

  Új Válasz 2021-07-01 16:11:04 #47066

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  szricsi_0917

  tag

  válasz Delila_1 #47045 üzenetére

  Szia

  Ahogy mondtam neked becsatolom az elvileg majdnem végleges megoldást. Most 4x csinálja meg a folyamatot, mert 4 sheeten is végig kell mennie. Ahogy látom így is elég gyors lett.

  Private Sub Kalkuláció_Click()
Dim i As Long, InduloIdo As Single
InduloIdo = Timer
Dim sor_allapot As Integer
Dim sor_anyag As Integer
Dim oszlop As Integer
Dim lastrow_allapot As Integer
Dim lastrow_anyag As Integer
Dim sorszam As Integer
Dim cikkszam As String
Dim osszeg As Double
Dim TIB As String
Dim csere_sor As Integer
Dim csere_oszlop As Integer
If tib_lista.Value = "" Then
    MsgBox "Nincs kitöltve TIB azonosító!", vbCritical, "Figyelmeztetés"
    Exit Sub
 Else
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
    
    
    
    
lastrow_allapot = Sheets("Gerinc kiépítés állapot").Range("S" & Rows.Count).End(xlUp).Row
lastrow_anyag = Sheets("Anyagösszesítő").Range("a" & Rows.Count).End(xlUp).Row
cikkszam = ""
TIB = tib_lista.Value
Sheets("Anyagösszesítő").Range("F2:F" & lastrow_anyag) = ""
    For sor_allapot = 3 To lastrow_allapot
        If Sheets("Gerinc kiépítés állapot").Cells(sor_allapot, "S") = TIB Then
            For sor_anyag = 2 To lastrow_anyag
            osszeg = 0
            cikkszam = Sheets("Anyagösszesítő").Cells(sor_anyag, 2)
            sorszam = Sheets("Gerinc kiépítés állapot").Cells(sor_allapot, 1)
                    For oszlop = 67 To 162 Step 5
                        If Sheets("Gerinc kiépítés adat").Cells(sorszam, oszlop - 1) = cikkszam Then
                            osszeg = osszeg + Sheets("Gerinc kiépítés adat").Cells(sorszam, oszlop)
                        End If
                    Next
                    Sheets("Anyagösszesítő").Cells(sor_anyag, "F").Value = Sheets("Anyagösszesítő").Cells(sor_anyag, "F").Value + osszeg
            Next
        End If
    Next
    
    
    
    
lastrow_allapot = Sheets("Alépítmény állapot").Range("z" & Rows.Count).End(xlUp).Row
lastrow_anyag = Sheets("Anyagösszesítő").Range("a" & Rows.Count).End(xlUp).Row
cikkszam = ""
Sheets("Anyagösszesítő").Range("g2:g" & lastrow_anyag) = ""
    For sor_allapot = 3 To lastrow_allapot
        If Sheets("Alépítmény állapot").Cells(sor_allapot, "z") = TIB Then
            For sor_anyag = 2 To lastrow_anyag
            osszeg = 0
            cikkszam = Sheets("Anyagösszesítő").Cells(sor_anyag, 2)
            sorszam = Sheets("Alépítmény állapot").Cells(sor_allapot, 1)
                    For oszlop = 81 To 176 Step 5
                        If Sheets("Alépítmény adat").Cells(sorszam, oszlop - 1) = cikkszam Then
                            osszeg = osszeg + Sheets("Alépítmény adat").Cells(sorszam, oszlop)
                        End If
                    Next
                    Sheets("Anyagösszesítő").Cells(sor_anyag, "g").Value = Sheets("Anyagösszesítő").Cells(sor_anyag, "g").Value + osszeg
            Next
        End If
    Next
    
    
    
        
lastrow_allapot = Sheets("Házhálózat állapot").Range("v" & Rows.Count).End(xlUp).Row
lastrow_anyag = Sheets("Anyagösszesítő").Range("a" & Rows.Count).End(xlUp).Row
cikkszam = ""
Sheets("Anyagösszesítő").Range("h2:h" & lastrow_anyag) = ""
    For sor_allapot = 3 To lastrow_allapot
        If Sheets("Házhálózat állapot").Cells(sor_allapot, "v") = TIB Then
            For sor_anyag = 2 To lastrow_anyag
            osszeg = 0
            cikkszam = Sheets("Anyagösszesítő").Cells(sor_anyag, 2)
            sorszam = Sheets("Házhálózat állapot").Cells(sor_allapot, 1)
                    For oszlop = 84 To 179 Step 5
                        If Sheets("Házhálózat adat").Cells(sorszam, oszlop - 1) = cikkszam Then
                            osszeg = osszeg + Sheets("Házhálózat adat").Cells(sorszam, oszlop)
                        End If
                    Next
                    Sheets("Anyagösszesítő").Cells(sor_anyag, "h").Value = Sheets("Anyagösszesítő").Cells(sor_anyag, "h").Value + osszeg
            Next
        End If
    Next
    
  
    
lastrow_allapot = Sheets("Optikai kötés állapot").Range("q" & Rows.Count).End(xlUp).Row
lastrow_anyag = Sheets("Anyagösszesítő").Range("a" & Rows.Count).End(xlUp).Row
cikkszam = ""
Sheets("Anyagösszesítő").Range("i2:i" & lastrow_anyag) = ""
    For sor_allapot = 3 To lastrow_allapot
        If Sheets("Optikai kötés állapot").Cells(sor_allapot, "q") = TIB Then
            For sor_anyag = 2 To lastrow_anyag
            osszeg = 0
            cikkszam = Sheets("Anyagösszesítő").Cells(sor_anyag, 2)
            sorszam = Sheets("Optikai kötés állapot").Cells(sor_allapot, 1)
                    For oszlop = 64 To 159 Step 5
                        If Sheets("Optikai kötés adat").Cells(sorszam, oszlop - 1) = cikkszam Then
                            osszeg = osszeg + Sheets("Optikai kötés adat").Cells(sorszam, oszlop)
                        End If
                    Next
                    Sheets("Anyagösszesítő").Cells(sor_anyag, "i").Value = Sheets("Anyagösszesítő").Cells(sor_anyag, "i").Value + osszeg
            Next
        End If
    Next
    
    
Sheets("Anyagösszesítő").Select
 For csere_oszlop = 6 To 9
   For csere_sor = 2 To lastrow_anyag
     If Sheets("Anyagösszesítő").Cells(csere_sor, csere_oszlop) = 0 Then
      Sheets("Anyagösszesítő").Cells(csere_sor, csere_oszlop) = "-"
      End If
    Next
 Next
 
        tib_lista.Value = ""
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        Application.DisplayStatusBar = True
        Application.EnableEvents = True
    MsgBox "Az összesítés elkészült!" & vbNewLine & vbNewLine & "Futási idő: " & Format((Timer - InduloIdo) / 86400, "hh:mm:ss") & vbNewLine, , ""  '86400 = 24*60*60
End If
End Sub

Új hozzászólás Aktív témák