Forum strony www.multipasko.pl [Regulamin]


Dodaj wpis w tym temacie
Spis tematów
Login:

Hasło:
Strona: 1 2 ... 52 53 54
Wyślij wiadomość do admina

Przewiń wpisy ↓

Excel- potrzebna pomoc

2025-01-17 (22:41)

status MultiTest
Data rejestracji: 2020-08-05 00:00:00
Ilość postów: 5644

16235
wpis nr 1 548 117
[ CZCIONKA MONOSPACE ]

Jeżeli te komórki są wypełniane przez jakieś makro to najprościej zmienić makro aby nie wpisywało dubli .
2025-01-18 (08:29)

status fair_play
Data rejestracji: 2016-05-12 00:00:00
Ilość postów: 8349

14865
wpis nr 1 548 162
[ CZCIONKA MONOSPACE ]


casshern

W jaki sposób przekazać Ci rozwiązanie problemu (procedurę makro) ?
2025-01-18 (09:17)

status MultiTest
Data rejestracji: 2020-08-05 00:00:00
Ilość postów: 5644

16235
wpis nr 1 548 166
[ CZCIONKA MONOSPACE ]

fair_play
Jeżeli było tak mało istotne to trzeba było tak zostawić...
W programowaniu jest często problem z wartością domyślną, np. arkuszu kalkulacyjnym to może być problem ustalenia domyślnej szerokości kolumny aby w większości przypadków user nie musiał mieć dodatkowej roboty z jej ustawianiem.
Potem co zrobić jeżeli user wpisze liczbą którą się w kolumnie nie mieści.
Można tak zrobić aby kolumna się automatycznie się poszerzała, jednak może na przykład popsuć to dopasowanie do innych wartości w tej kolumnie.
Zastosowanym rozwiązaniem jest zmiana formatu liczby który zajmuje mniej miejsca.

--- wpis edytowano 2025-01-18 09:18 ---

2025-01-18 (09:24)

status fair_play
Data rejestracji: 2016-05-12 00:00:00
Ilość postów: 8349

14865
wpis nr 1 548 167
[ CZCIONKA MONOSPACE ]


Multi, nie pomyliłeś wątków?
2025-01-18 (09:59)

status MultiTest
Data rejestracji: 2020-08-05 00:00:00
Ilość postów: 5644

16235
wpis nr 1 548 173
[ CZCIONKA MONOSPACE ]

temat uniwersalny
ale faktycznie...
2025-01-18 (11:00)

status casshern
Data rejestracji: 2015-01-11 00:00:00
Ilość postów: 237

14269
wpis nr 1 548 182
[ CZCIONKA MONOSPACE ]

Witam.

Tak fair_play może być makro.
2025-01-18 (11:27)

status fair_play
Data rejestracji: 2016-05-12 00:00:00
Ilość postów: 8349

14865
wpis nr 1 548 188
[ CZCIONKA MONOSPACE ]


Ale jak Ci je przekazać?
2025-01-18 (13:56)

status kleszek
Data rejestracji: 2006-05-27 00:00:00
Ilość postów: 4953

2047
wpis nr 1 548 223
[ CZCIONKA MONOSPACE ]

casshern, z ciekawości testuję chatGPT. To świetne narzędzie dla tych co potrzebują "na szybko" rozwiązania albo dla tych, co nie chcą się uczyć i idą po najmniejszej linii oporu (czyli np. dla mnie). Poprosiłem chata o wygenerowanie makra spełniającego twoje warunki. Otrzymałem takie rozwiązanie. Sprawdź czy makro działa prawidłowo

Sub RemoveDuplicatesAndSortRows()
Dim ws As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim rowRange As Range
Dim cell As Range
Dim uniqueValues As Collection
Dim i As Long, j As Long
Dim arr() As Variant

' Ustawienie aktywnego arkusza
Set ws = ActiveSheet

' Znalezienie ostatniego wiersza z danymi w arkuszu
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

' Pętla przez każdy wypełniony wiersz
For i = 1 To lastRow
' Znalezienie ostatniej używanej kolumny w danym wierszu
lastCol = ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column

' Ustawienie zakresu dla aktualnego wiersza
Set rowRange = ws.Range(ws.Cells(i, 1), ws.Cells(i, lastCol))

' Utworzenie kolekcji unikalnych wartości
Set uniqueValues = New Collection
On Error Resume Next
For Each cell In rowRange
If cell.Value <> "" Then
uniqueValues.Add cell.Value, CStr(cell.Value)
If Err.Number <> 0 Then
cell.ClearContents
Err.Clear
End If
End If
Next cell
On Error GoTo 0

' Zapisanie unikalnych wartości do tablicy
If uniqueValues.Count > 0 Then
ReDim arr(1 To uniqueValues.Count)
For j = 1 To uniqueValues.Count
arr(j) = uniqueValues(j)
Next j

' Posortowanie tablicy rosnąco
Call BubbleSort(arr)

' Wstawienie posortowanych wartości do wiersza
For j = LBound(arr) To UBound(arr)
ws.Cells(i, j).Value = arr(j)
Next j

' Wyczyszczenie pozostałych komórek w wierszu
If UBound(arr) < lastCol Then
ws.Range(ws.Cells(i, UBound(arr) + 1), ws.Cells(i, lastCol)).ClearContents
End If
End If
Next i

MsgBox "Duplikaty usunięte, a wiersze posortowane.", vbInformation
End Sub

' Funkcja do sortowania tablicy za pomocą algorytmu bąbelkowego
Sub BubbleSort(ByRef arr() As Variant)
Dim i As Long, j As Long
Dim temp As Variant
For i = LBound(arr) To UBound(arr) - 1
For j = LBound(arr) To UBound(arr) - i - 1
If arr(j) > arr(j + 1) Then
temp = arr(j)
arr(j) = arr(j + 1)
arr(j + 1) = temp
End If
Next j
Next i
End Sub
2025-01-18 (15:10)

status MultiTest
Data rejestracji: 2020-08-05 00:00:00
Ilość postów: 5644

16235
wpis nr 1 548 241
[ CZCIONKA MONOSPACE ]

casshern może na przykład używać losowych liczb i dlatego są powtórzenia.
Od tego trzeba zacząć żeby powtórzenia nie były zapisywane aby nie robić sobie roboty z póżniejszym usuwaniem.
2025-01-18 (18:45)

status casshern
Data rejestracji: 2015-01-11 00:00:00
Ilość postów: 237

14269
wpis nr 1 548 267
[ CZCIONKA MONOSPACE ]

Mało dziś czasu na to wszystko ale sprawdzę makro. Dzięki.
2025-01-18 (19:55)

status casshern
Data rejestracji: 2015-01-11 00:00:00
Ilość postów: 237

14269
wpis nr 1 548 271
[ CZCIONKA MONOSPACE ]

kleszek mistrzu drugi raz robisz dla mnie super robotę, dziekuje ci bardzo, na szybko sprawdziłem i działa. Nie wiem czy zaprowadzi mnie to do wymarzonego celu ale próbuję.

Dziekuję wszystkim za zaangażowanie w moją sprawę pozdrawiam.
2025-01-18 (20:52)

status fair_play
Data rejestracji: 2016-05-12 00:00:00
Ilość postów: 8349

14865
wpis nr 1 548 280
[ CZCIONKA MONOSPACE ]


casshern>

Trochę się sóźniłem, ale może spróbuj i tego
Z tym, że w nagłówku makr wykasuj "Option Explicit" ponieważ nie deklaruję zmiennych, a wstaw tam "Option Base 1" ponieważ tablice numeruję od 1, a nie od o.

Pozdrawiam

Sub usuń_duble()

Application.ScreenUpdating = False

With ThisWorkbook.ActiveSheet
kolumn = .UsedRange.Columns(.UsedRange.Columns.Count).Column
End With
wierszy = Application.WorksheetFunction.CountA(Range("A1:A65636"))

mat = Range(Cells(1, 1), Cells(wierszy, kolumn))

For y = 1 To wierszy
For x = 1 To kolumn - 1
For xx = x + 1 To kolumn
If mat(y, xx) = mat(y, x) Then mat(y, xx) = " "
Next
Next
Next

Range(Cells(1, 1), Cells(wierszy, kolumn)) = mat

For y = 1 To wierszy
Rows(y).Select
ThisWorkbook.ActiveSheet.Sort.SortFields.Clear
ThisWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(y, 1), Cells(y, kolumn)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ThisWorkbook.ActiveSheet.Sort
.SetRange Range(Cells(y, 1), Cells(y, kolumn))
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Next

Application.ScreenUpdating = True

End Sub
2025-01-18 (21:36)

status casshern
Data rejestracji: 2015-01-11 00:00:00
Ilość postów: 237

14269
wpis nr 1 548 291
[ CZCIONKA MONOSPACE ]

Dzięki fair_play, wszystkiego dobrego.

Pozdrawiam.
2025-01-24 (13:05)

status casshern
Data rejestracji: 2015-01-11 00:00:00
Ilość postów: 237

14269
wpis nr 1 549 179
[ CZCIONKA MONOSPACE ]

Witam wszystkich.

Ponownie zwracam się z prośbą, odnośnie makro w excelu.

Otóż potrzebuję coś na wzór inversji, tz. chciałbym aby makro automatycznie uzupełniło mi brakujące liczby w danym wierszu. Oczywiście tych wierszy będzie kilkadziesiąt. np.

1. mam zbiór różnych nie powtarzających się 43 liczb w jednym wierszu, w tym miejscu makro(po uruchomieniu) pokazuje mi 6 brakujących
2. mam zbiór 42 liczb w jednym wierszu, i również w tym miejscu makro pokazuje mi 7 brakujących
3. mam zbiór 41 liczb i makro pokazuje mi 8 brakujących
4. itd.

Za pomoc będę bardzo wdzięczny.

Pozdrawiam.
2025-01-24 (15:44)

status fair_play
Data rejestracji: 2016-05-12 00:00:00
Ilość postów: 8349

14865
wpis nr 1 549 196
[ CZCIONKA MONOSPACE ]


casshern>

Proszę bardzo:

Brakujące w wierszach liczby pojawiają się od kolumny 50 w prawo.

Sub braki()

Dim wierszy, dane, liczba, x, y, pozycja As Integer


wierszy = Application.WorksheetFunction.CountA(Range("A1:A65636"))

dane = Range(Cells(1, 1), Cells(wierszy, 49))
ReDim maska(wierszy, 49)

For y = 1 To wierszy
For x = 1 To 49
liczba = dane(y, x)
maska(y, liczba) = 1
Next
Next

For y = 1 To wierszy
pozycja = 50
For x = 1 To 49
If maska(y, x) < 1 Then
Cells(y, pozycja) = x
pozycja = pozycja + 1
End If
Next
Next

End Sub
2025-01-24 (15:57)

status casshern
Data rejestracji: 2015-01-11 00:00:00
Ilość postów: 237

14269
wpis nr 1 549 199
[ CZCIONKA MONOSPACE ]

Hey fair_play

wyskakuje mi bład:

Run-time error '9':
Subscript out of range

klikając Debug podświetla mi się na żółto ta pozycja w makro:

maska (y, liczba )=1

Nie obczajam w czym może być problem, pomożesz?

p.s dziękuję za szybką reakcje na moja proźbę.

Pozdrawiam.
2025-01-24 (16:03)

status 777ch
Data rejestracji: 2005-11-07 00:00:00
Ilość postów: 22352

1386
wpis nr 1 549 201
[ CZCIONKA MONOSPACE ]

maska (y, liczba )=
Jeśli masz liczbę większą niż 49
lub w tym wierszu to nie jest liczba
to wystąpi błąd
2025-01-24 (16:05)

status fair_play
Data rejestracji: 2016-05-12 00:00:00
Ilość postów: 8349

14865
wpis nr 1 549 202
[ CZCIONKA MONOSPACE ]


a jak najedziesz wskaźnikiem myszy w tej żółtej linii na y i liczba to jakie wartości Ci się wyświetlają?
2025-01-24 (16:09)

status casshern
Data rejestracji: 2015-01-11 00:00:00
Ilość postów: 237

14269
wpis nr 1 549 203
[ CZCIONKA MONOSPACE ]

777ch największą liczbę w wierszach a mam ich 214 jest liczba 49, tylko w tych wierszach są różne wielkości zbiorów tzn. część wierszów zawiera 43,42,41 niepowtarzających sie liczb, wszystkich od 1 do 49.
2025-01-24 (16:10)

status casshern
Data rejestracji: 2015-01-11 00:00:00
Ilość postów: 237

14269
wpis nr 1 549 204
[ CZCIONKA MONOSPACE ]

y 50 wyświetla się

--- wpis edytowano 2025-01-24 16:11 ---

| Dodaj wpis w tym temacie | Spis tematów | Wyniki lottoStrona: 1 2 ... 52 53 54
Wyślij wiadomość do admina