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

• #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

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