Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - scalanie w excelu

morarz · Starszy Forumowicz Posty: 30

Witam,

Mam np. scalony tekst z liczbami : MM09876544 w 4 komórkach jak zrobić żeby po od scaleniu te wartości w tych 4 komórkach się pojawiły czyli
A1 MM09876544
A2 MM09876544
A3 MM09876544
A4 MM09876544

żeby nie trzeba było ręcznie je kopiować od początku...

Z góry dziękuje za odpowiedź.

Zmora · Excel Expert **Pomógł:** 763 razy Posty: 1598

Po odscaleniu wciśnij

Kod:

CTRL+R

morarz · Starszy Forumowicz Posty: 30

a da się to inaczej zrobić niż poprzez wypełnij z lewej ?? Chodzi mi o funkcję bo szukam i nie moge znaleźć takiej funkcji.

Zmora · Excel Expert **Pomógł:** 763 razy Posty: 1598

Makrem. Dla zaznaczonego zakresu:

Kod:

Option Explicit

Sub scalone()
Dim kom As Excel.Range
Dim a As Long
a = Selection.Column
For Each kom In Selection
kom.UnMerge
kom.Value = Cells(kom.Row, a)

Next kom
End Sub

morarz · Starszy Forumowicz Posty: 30

Zmora niestety nie działa. Robi tylko odscalanie komórek a nie kopiuje danych do dalszych komórek...

Zmora · Excel Expert **Pomógł:** 763 razy Posty: 1598

U mnie działa, pokaż to na swoim pliku.

morarz · Starszy Forumowicz Posty: 30

w załączniku plik...

Nowy Arkusz programu Microsoft Office Excel11.rar

Pobierz Plik ściągnięto 12 raz(y) 11.46 KB

Zmora · Excel Expert **Pomógł:** 763 razy Posty: 1598

No tak, ja bawiłem się w wierszach a Ty w kolumnach :-D

Przetestuj takie makro:

Kod:

Sub Scalone()

Dim i As Long
Dim a As Long
Dim x As Long
Dim tbl2()
a = Cells(Rows.Count, "A").End(xlUp).Row
x = 1

For i = 2 To a
If Cells(i, 1).Value <> "" Then

ReDim Preserve tbl2(1 To x)
tbl2(x) = i
x = x + 1
End If

Next i

For i = 1 To UBound(tbl2)
If Cells(tbl2(i), "A").MergeCells Then
With Cells(tbl2(i), "A").MergeArea
.UnMerge
.Value = Cells(tbl2(i), 1).Value
End With
End If
Next i
End Sub

morarz · Starszy Forumowicz Posty: 30

działa dzięki tylko szkoda że dla kolumny A tylko. Gdy próbuję to zrobić dla innej kolumny nic się nie dzieje.

Zmora · Excel Expert **Pomógł:** 763 razy Posty: 1598

morarz, ale marudzisz :-D

Albo InputBox, albo Selection.
Przy InputBox podajesz numer kolumny - liczbę, albo nazwę literową.
Opcje wykomentowane.

Kod:

Option Explicit

Sub Scalone()

Dim i As Long
Dim a As Long
Dim x As Long
'Dim iCol As Long
Dim iCol As String
'iCol = Selection.Column
'iCol = Application.InputBox("Podaj nr kolumny", 1)
iCol = Application.InputBox("Podaj nr kolumny", 2)
Dim tbl2()

On Error GoTo blad
a = Cells(Rows.Count, iCol).End(xlUp).Row

x = 1

For i = 2 To a
If Cells(i, iCol).Value <> "" Then

ReDim Preserve tbl2(1 To x)
tbl2(x) = i
x = x + 1
End If

Next i

For i = 1 To UBound(tbl2)
If Cells(tbl2(i), iCol).MergeCells Then
With Cells(tbl2(i), iCol).MergeArea
.UnMerge
.Value = Cells(tbl2(i), iCol).Value
End With
End If
Next i
blad:
End Sub