02. juni 2004 - 08:35Der er
12 kommentarer og 1 løsning
Macro til ændring af tekst
Skal bruge en macro, som gør følgende.
I kolonne "G" findes 1. celle med et beløb. Skriften ændres til fed, derefter 2 celler ned skriften ændres til fed. Det skal gentages indtil teksten "LTAT" forefindes i en cellen. Så skal næste celle med et beløb findes osv. indtil hele kolonne er "søgt" igennem.
Det er altid kolonne G og udgangspunktet er altid celle "G1".
Sub test() Dim myrange As Range, c As Range, lookfor As Variant lookfor = Application.InputBox("Søg efter :") Set myrange = Range("G:G") For Each c In myrange If CStr(c) = lookfor Then c.Font.Bold = True c.Offset(1, 0).Font.Bold = True c.Offset(2, 0).Font.Bold = True Else If c = "LTAT" Then Exit Sub End If Next End Sub
Hvad er det lige denne macro gør ?? Kan man ikke bare sætte den til at finde den 1. celle indeholdene et beløb.
Desuden har jeg opdaget, at det nogen gange er nødvendigt at gå 3 celler ned. Dvs. hvis cellen er tom, da ned en ekstra gang. Arket indeholder pt. 14500 rækker, men om 14 dage kan det være flere eller færre.
dette skulle kompensere for at 2. celle er tom. Den spørger dig hvad du ønsker at søge efter. Derefter "feder" de celler den finder + de 2 næstkommende. Hvis første næstkommende er tom "feder" den de næste 2
Sub test() Dim myrange As Range, c As Range, lookfor As Variant lookfor = Application.InputBox("Søg efter :") Set myrange = Range("G:G") For Each c In myrange If CStr(c) = lookfor Then c.Font.Bold = True If Not IsEmpty(c.Offset(1, 0)) Then c.Offset(1, 0).Font.Bold = True Else c.Offset(3, 0).Font.Bold = True End If c.Offset(2, 0).Font.Bold = True Else If c = "LTAT" Then Exit Sub End If Next End Sub
Sub test() Dim myrange As Range, c As Range, Str As String, Rk As Long, Skift As Boolean Skift = False Rk = Range("G65536").End(xlUp).Row Str = "LTAT" ' skifte streng Set myrange = Range("G1:G" & Rk)
For Each c In myrange.Cells If c.Row = 1 And IsNumeric(c) Then c.Font.Bold = True 'første celle
ElseIf Skift = True And c <> Str And c.Row > 1 Then If c.Offset(-1, 0).Font.Bold = False Then c.Font.Bold = True Else c.Font.Bold = False End If ElseIf IsNumeric(c) And Skift = False Then c.Font.Bold = True Skift = True ElseIf c = Str Then Skift = False End If Next End Sub
Sub test() Dim myrange As Range, c As Range, Str As String, Rk As Long, Skift As Boolean Skift = False Rk = Range("G65536").End(xlUp).Row Str = "LTAT" ' skifte streng Set myrange = Range("G1:G" & Rk)
For Each c In myrange.Cells If c.Row = 1 Then If IsNumeric(c) Then c.Font.Bold = True 'første celle Skift = True Else c.Font.Bold = False End If ElseIf Skift = True And c <> Str And c.Row > 1 Then If c.Offset(-1, 0).Font.Bold = False Then c.Font.Bold = True Else c.Font.Bold = False End If ElseIf Skift = False Then If IsNumeric(c) Then c.Font.Bold = True Skift = True Else c.Font.Bold = False End If ElseIf c = Str Then Skift = False End If Next End Sub
Sub test() Dim myrange As Range, c As Range, Rk As Long Rk = Range("F65536").End(xlUp).Row Set myrange = Range("F1:F" & Rk)
For Each c In myrange.Cells If UCase(c) = "EFT" Or UCase(c) = "FØR" Then c.Offset(0, 1).Font.Bold = True 'første celle Else c.Offset(0, 1).Font.Bold = False End If Next End Sub
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
Ny bruger
Nybegynder
Opret
Preview
