vba الي كود COUNTIF تحويل

[hanykassem]

السلام عليكم ورحمه الله وبركاته وبها نبدأ

 vba الي كود COUNTIF تحويل 

=COUNTIF(G$3:G3,G3)

TEST COUNTIF.xlsx

[عبدالله بشير عبدالله]

وعليكم السلام ورحمة الله وبركاته

الكود

Sub CountIfToColumnH()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row

    For i = 2 To lastRow
        ws.Cells(i, "H").Value = Application.WorksheetFunction.CountIf(ws.Range("G$2:G" & i), ws.Cells(i, "G").Value)
    Next i
End Sub

الملف

TEST COUNTIF.xlsb

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته 

يمكنك استخدام كدالك 

Sub addFormula()
Dim lr&
    With ThisWorkbook.Sheets("Sheet1")
        
        lr = .Cells(.Rows.Count, "G").End(xlUp).Row
        .Range("H2:H" & lr).Formula2 = "=COUNTIF(G$2:G" & lr & ", G2)"
    End With
End Sub

ولتنفيده عند التغيير تلقائيا  مع اظافة المعادلة الموجودة في عمود G يمكنك وضع الكود التالي في حدث Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim lr As Long
    lr = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
    'column (G)
    With Me.Range("G2:G" & lr)
        .Formula2 = "=TEXTJOIN(""-"", TRUE, A2, C2)"
        .Value = .Value
    End With
    'column (H)
    With Me.Range("H2:H" & lr)
        .Formula2 = "=COUNTIF(G$2:G" & lr & ", G2)"
        .Value = .Value
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

[FranklinWrights]

On 9/13/2024 at 11:16 AM, محمد هشام. said:

وعليكم السلام ورحمة الله تعالى وبركاته 

يمكنك استخدام كدالك 

Sub addFormula()
Dim lr&
    With ThisWorkbook.Sheets("Sheet1")
        
        lr = .Cells(.Rows.Count, "G").End(xlUp).Row
        .Range("H2:H" & lr).Formula2 = "=COUNTIF(G$2:G" & lr & ", G2)"
    End With
End Sub

ولتنفيده عند التغيير تلقائيا  مع اظافة المعادلة الموجودة في عمود G يمكنك وضع الكود التالي في حدث Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim lr As Long
    lr = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
    'column (G)
    With Me.Range("G2:G" & lr)
        .Formula2 = "=TEXTJOIN(""-"", TRUE, A2, C2)"
        .Value = .Value
    End With
    'column (H)
    With Me.Range("H2:H" & lr)
        .Formula2 = "=COUNTIF(G$2:G" & lr & ", G2)"
        .Value = .Value
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Nox Vidmate VLC

شكرا

تم تعديل سبتمبر 16 بواسطه FranklinWrights