Ú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

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