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

• #51265 13128814 tag

  Új Válasz 2023-08-04 15:31:14 #51265

  Ú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

  

  13128814

  tag

  Sziasztok!

  Egy pivot generálásnál akadtam el és a ChatGPT sem barátom már ebben.

  A jelenség az, hogy ha a generált pivotban szűrök, akkor a mellette lévő sorok nem követik le a szűrést hanem fixen ott maradnak (mármint a pivot tartomány melletti sorok). Ezzel az a baj, hogy az AH-nak egyenlőnek kell lennie az A oszlopban lévő adatokkal (ebben a formában: A6 = AH6), mert utána sok képletem van. Csak mivel a pivotban alkotott szűrés nincs kihatással az AH-tól kezdődő oszlopokra, így a képletek fals számokat kalkulálnak. Hogyan tudnám függővé tenni a többi oszlop sorát is a pivot szűrésétől?

  Itt generálom le a pivotot:

  Sub pivot(ByRef ujWb As Workbook)
    Dim PTable As pivotTable
    Dim PCache As PivotCache
    Dim PRange As Range
    Dim PSheet As Worksheet
    Dim DSheet As Worksheet
    Dim LR As Long
    
    Set PSheet = ujWb.Worksheets(1)
    Set DSheet = ujWb.Worksheets(2)
    
    LR = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    Set PRange = DSheet.Range("A2:S" & LR)
    Set PCache = ujWb.PivotCaches.Create _
        (xlDatabase, SourceData:=PRange)
        
    On Error Resume Next
    Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PIVOT")
    On Error GoTo 0
    If PTable Is Nothing Then
        MsgBox "Nem sikerült létrehozni a pivot táblát. Ellenőrizd a célcellát és az adatokat.", vbExclamation
    Else
        ' Pivot tábla létrehozva sikeresen, folytasd a kód futtatását
        
        With PSheet.PivotTables("PIVOT").PivotFields("Design_no")
            .Orientation = xlRowField
            .Position = 1
        End With
    
        With PSheet.PivotTables("PIVOT").PivotFields("Code")
            .Orientation = xlColumnField
            .Position = 1
        End With
        
        With PSheet.PivotTables("PIVOT").PivotFields("Kártya gyári szám")
            .Orientation = xlDataField
            .Position = 1
        End With
        
        With PSheet.PivotTables("PIVOT").PivotFields("CH")
            .Orientation = xlPageField
            .Position = 1
        End With
        
        With PSheet.PivotTables("PIVOT").PivotFields("változás")
            .Orientation = xlPageField
            .Position = 2
        End With
        
        With PSheet.PivotTables("PIVOT").PivotFields("Elérhető")
            .Orientation = xlPageField
            .Position = 3
        End With
    End If
End Sub

  Itt töltöm ki az AH-t:

  Sub pivotAtalakitas(ByRef ujWb As Workbook)
    
    Dim LR As Long
    Dim ws As Worksheet
    Dim LastRowCell As Range
    Set ws = ujWb.Worksheets("PIVOT")
    Set LastRowCell = ws.Columns("A").Find(What:="*", After:=ws.Cells(1, "A"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    
    If Not LastRowCell Is Nothing Then
        LR = LastRowCell.Row
        Debug.Print LR
        Dim i As Long
        For i = 6 To LR
            ws.Cells(i, "AH").Value = ws.Cells(i, "A")
        Next i
    Else
        Debug.Print "A oszlop üres"
    End If
    
    ThisWorkbook.Worksheets("Fejléc").Range("A4:J5").Copy
    ujWb.Worksheets(1).Range("AI4").PasteSpecial
    Application.CutCopyMode = False
    
End Sub

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