Opret data i henhold til anden kolonne

I A3 kan du bruge formlen
=COUNTIF(B1:B15;"<>")

Den tæller antallet af ikke-tomme celler i området B1:B15

Det skulle helst være et makro.
Og den skal ikke kun beregne (Count) men derimod om Kolonne B celle 3 = värdi så skal den skrive en feks 'Hej' i kollonne A celle 3 og fortsätte nedad.

:-)

Lav en formel i A3 (eller den start celle du vælger)

Formel: =Hvis(B3=<>" ";"Hej";" ")

Lav en makro, som finder ud af, hvormange celler der er udfyldt i. Indspil den f.eks. på følgende måde:

Gå til A3
Ctrl+C
pil til højre
Rediger
gå til
speciel
sidste celle
OK
pil til venstre
Shift+end pilop
Ctrl+V

Er der ikke en bedre måde at gøre det på fordi det er ikka sikkert att det alltid er samme antal celler.
Forøvrigt gik den et helt andet sted når jeg valgte sidste celle????:-)

Sub test()
Dim Rng As Range
Dim start As Range
Dim slut As Range
Dim c As Range
Dim x As Long, i As Long
Dim Streng As String
Streng = "Hej"
Set start = Range("B3")
Set slut = Application.InputBox("Hvor vil du have dine data ? " & vbCrLf & "Angiv 1. celle", Type:=8)
Set Rng = Range(start.Address, Cells(65536, start.Column).End(xlUp).Address)

For Each c In Rng
x = x + 1
    If Len(c.Value) > 0 Then slut(x, 1) = Streng
 
Next
End Sub

Hej igen Bak :-)

Dejligt at få hjälp af dig igen.
Det virker men hvad nu hvis det skal sættes ind i Blad2 (Sheet2) og spørgsmålet som kommer op (Hvor vil du have dine data?) istedet spørger om hvad jeg vil ha i feltet?

Kan du også ordne det?

Sub test()
Dim Rng As Range
Dim start As Range
Dim slut As Range
Dim c As Range
Dim x As Long, i As Long
Dim Streng As String

Set start = Worksheets("Sheet1").Range("B3")
Set slut = Worksheets("Sheet2").Range("A5")
Streng = InputBox("Hvad skal der stå i cellerne")
Set Rng = Worksheets("Sheet1").Range(start.Address, Worksheets("Sheet1").Cells(65536, start.Column).End(xlUp).Address)

For Each c In Rng
x = x + 1
    If Len(c.Value) > 0 Then slut(x, 1) = Streng
Next
End Sub

Igen igen er du bare go´ :-)

Mange tak for hjälpen og fortsat god dag til jer alle.

Som tak for hjælpen får:
Blackadder 15 p
Keil 15 p

Bak! Du havde jo ikke svaret men om du vil have dine points så send lige en reminder :-)

Nej, det er ok, det er jo stort set den samme makro, der er brugt i alle dine spørgsmål :-)

Bak!

Hvordan får jeg den til, at IKKE skrive over eventuelle data som allerede findes i destinationsfeltet?
Den skal kun skrive i feltet såfremt det er tomt?

På forhånd tak :-)

Sub test()
Dim Rng As Range
Dim start As Range
Dim slut As Range
Dim c As Range
Dim x As Long, i As Long
Dim Streng As String

Set start = Worksheets("Sheet1").Range("B3")
Set slut = Worksheets("Sheet2").Range("A5")
Streng = InputBox("Hvad skal der stå i cellerne")
Set Rng = Worksheets("Sheet1").Range(start.Address, Worksheets("Sheet1").Cells(65536, start.Column).End(xlUp).Address)

For Each c In Rng
x = x + 1
    If Len(c.Value) > 0 And Len(slut(x, 1)) > 0 Then slut(x, 1) = Streng
Next
End Sub

Hej igen igen :-)

Nu overskriver den netop de felter som der allerede er tekst i men ikke i dem som er tomme som den skulle?

Sub Produkt()
Dim Rng As Range
Dim start As Range
Dim slut As Range
Dim c As Range
Dim x As Long, i As Long
Dim Streng As String

Set start = Worksheets("Blad1").Range("O3")
Set slut = Worksheets("Blad2").Range("M3")
Streng = InputBox("Hvad skal der stå i cellerne")
Set Rng = Worksheets("Blad1").Range(start.Address, Worksheets("Blad1").Cells(65536, start.Column).End(xlUp).Address)

For Each c In Rng
x = x + 1
    If Len(c.Value) > 0 And Len(slut(x, 1)) > 0 Then slut(x, 1) = Streng
Next
End Sub

ændre denne linie
If Len(c.Value) > 0 And Len(slut(x, 1)) > 0 Then slut(x, 1) = Streng

til
If Len(c.Value) > 0 And Len(slut(x, 1)) = 0 Then slut(x, 1) = Streng