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

• #26426 Delila_1 veterán Zola007 #26424

  Új Válasz 2015-04-06 15:29:01 #26426

  Ú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 Zola007 #26424 üzenetére

  Újra elolvastam az eredeti kérdést, így már csak a területet kell átírnod a makróban.

  Sub csere()
  Dim Cella As Range, b As Integer
  
  For Each Cella In Range("A1:A3") '*****
  If InStr(Cella.Value, "*") > 0 Then
  For b = 1 To Len(Cella)
  If Mid(Cella, b, 1) = "*" Then
  Cella.Characters(Start:=b, Length:=1).Font.Color = -16776961
  End If
  Next
  End If
  Next
  End Sub

  Ha biztos, hogy cellánként csak egy csillag van, akkor

  Sub csere_1()
  Dim Cella As Range, hol As Integer
  
  For Each Cella In Range("A1:A3") '*****
  On Error Resume Next
  hol = InStr(Cella.Value, "*")
  Cella.Characters(Start:=hol, Length:=1).Font.Color = -16776961
  Next
  End Sub

• #26425 Delila_1 veterán Zola007 #26424

  Új Válasz 2015-04-06 15:17:43 #26425

  Ú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 Zola007 #26424 üzenetére

  A lenti makró az A1:A3 tartományban írja át az a betűket pirosra.

  Sub csere()
  Dim Cella As Range, b As Integer
  
  For Each Cella In Range("A1:A3") '***** 1
  If InStr(Cella.Value, "a") > 0 Then '***** 2
  For b = 1 To Len(Cella)
  If Mid(Cella, b, 1) = "a" Then '***** 3
  Cella.Characters(Start:=b, Length:=1).Font.Color = -16776961 '***** 4
  End If
  Next
  End If
  Next
  End Sub

  A csillagos sorokban kell módosítanod.
  1. a területet az "A1:A3" helyére
  2. és 3. a keresendő szöveget az "a" helyére
  4. a Lenght:=1 -ben az 1 helyett a saját átszínezendő szöveged hosszát

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