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

• #48288 Delila_1 veterán Darth_Revan #48275

  Új Válasz 2022-01-24 14:29:20 #48288

  Ú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

  

  Delila_1

  veterán

  válasz Darth_Revan #48275 üzenetére

  Egy kis makró:
  Sub Csere_0_1()
    Dim sor As Long, oszlop As Integer
    sor = 1
    Do While Cells(sor, "A") > ""
        oszlop = Cells(sor, Columns.Count).End(xlToLeft).Column
        If Application.WorksheetFunction.CountIf(Range(Cells(sor, 1), Cells(sor, oszlop)), "kettő") > 0 Then
            Range(Cells(sor, 1), Cells(sor, oszlop)) = 1
        Else
            Range(Cells(sor, 1), Cells(sor, oszlop)) = 0
        End If
        sor = sor + 1
    Loop
End Sub
  
  

• #48287 Fire/SOUL/CD félisten Darth_Revan #48285

  Új Válasz 2022-01-24 14:27:46 #48287

  Ú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

  

  Fire/SOUL/CD

  félisten

  válasz Darth_Revan #48285 üzenetére

  Sebaj, ha már megírtam beteszem a kódot...

  Alapállás | Futtatás eredménye

  'Fire/SOUL/CD - 2022

Private Sub CommandButton1_Click()

'ezt a szöveget keressük
Const STRINGTOFIND = "kettő"
'ha megtalálható az adott sor cellájában, akkor erre lesz cserélve
Const REPLACESTRINGFINDTRUE = "1"
'ha nem található az adott sor cellájában, akkor erre lesz cserélve
Const REPLACESTRINGFINDFALSE = "NULLA"
'üres karakter, minden más cella erre lesz cserélve az adott sorban
Const EMPTYSTRING = ""

Dim MyRange As Range
Dim FindFlag As Boolean
Dim ReplaceString As String

Application.ScreenUpdating = False

'itt add meg a megfelelő tartományt
Set MyRange = Range("A1:F24")

For i = 0 To MyRange.Rows.Count - 1

FindFlag = False
For j = 0 To MyRange.Columns.Count - 1
If UCase(MyRange(1).Offset(i, j)) = UCase(STRINGTOFIND) Then
FindFlag = True
Exit For
End If
Next j

If FindFlag = True Then
ReplaceString = REPLACESTRINGFINDTRUE
Else
ReplaceString = REPLACESTRINGFINDFALSE
End If

MyRange(1).Offset(i, 0) = ReplaceString
For k = 1 To MyRange.Columns.Count - 1
MyRange(1).Offset(i, k) = EMPTYSTRING
Next k

Next i

Application.ScreenUpdating = True

End Sub

• #48279 Fire/SOUL/CD félisten Darth_Revan #48275

  Új Válasz 2022-01-24 12:05:03 #48279

  Ú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

  

  Fire/SOUL/CD

  félisten

  válasz Darth_Revan #48275 üzenetére

  Egy cellában vannak az adatok avagy 3 külön cellában?

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