Sub Makro9()
'
' Makro9 Makro
'
' Klawisz skrótu: Ctrl+Shift+Q
'
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim val As String
Dim slowo As Variant
Dim slowo2 As Variant
Dim Rng_1 As Range
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
.ScreenUpdating = True
End With
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
For j = 2 To 500
k = j - 1
Set Rng = Sheets("Arkusz1").Range("B" & j & ":B" & j)
Set Rng_1 = Sheets("Arkusz1").Range("B" & j - 1 & ":B" & j - 1)
TheString = Rng.Value
TheString_1 = Rng_1.Value
Position = InStr(TheString, " H ")
If Position <> 0 Then
slowo = Left(TheString, Position + 1)
slowo2 = Left(TheString, Position)
If Left(TheString, Position) = Left(TheString_1, Position) Then
Sheets("Arkusz1").Range("A" & j - 1 & ":A" & j - 1).Value = 1
End If
End If
Next j
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "A")
If Not IsError(.Value) Then
If .Value = 1 Then .EntireRow.Delete
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.Calculation = CalcMode
End With
Columns("A:A").Select
Selection.Delete
End Sub
Powinno dzialac. Pewnie daloby rade prosciej ale tym razem tak wyszlo...
ALT F11 --> Insert Module --> wkleić do modułu
skrót SHIFT+CTR+Q albo ALT F8 i wybrac makro9 z listy
nie ma tego złego, co by na dobre nie wyszło
jeśli lubisz miód, nie powinieneś bać się pszczół