Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 64421 Skopiuj do schowka wielkie litery
Autor Wiadomość
Klepicki 
Fan Excela



Posty: 66
Wysłany: 13-03-2019, 16:49   wielkie litery

Cześć,

Mam problem z makrem zmieniającym dane zawartość komórek na wielkie litery. W załączniku dołączam plik.

Obecnie kod sprawdza zakres A2:I1000 aby zmienić dane na wielkie litery, próbowałem i nie mogę dojść do tego jak zmienić zapis aby sprawdzał tylko te komórki w których jest zawartość z zakresu kolumna A do I. Jest to możliwe do zrealizowania?

Z góry dziękuje za pomoc :)

MAKRO: Uppercase
Kod:

   For Each x In Range("A2:I10000")
      ' Change the text in the range to uppercase letters.
      x.Value = UCase(x.Value)


export zostały PLIK_TESTOWY.xlsm
Pobierz Plik ściągnięto 5 raz(y) 98.34 KB

_________________
pozdr,
Kamil Łępicki
ID posta: 364143 Skopiuj do schowka
 
 
Tadek
Excel Expert


Pomógł: 1481 razy
Posty: 4761
Wysłany: 13-03-2019, 17:02   

Spróbuj tak:
Kod:
Dim ost&
ost = Cells(Rows.Count, "A").End(xlUp).Row
   For Each x In Range("A2:I" & ost)
      ' Change the text in the range to uppercase letters.
      x.Value = UCase(x.Value)
   Next
ID posta: 364145 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 2016
Pomógł: 1225 razy
Posty: 4202
Wysłany: 13-03-2019, 18:15   

Rozumiem, że chodzi o przyspieszenie operacji. Możesz wypróbować jeszcze takie dwa warianty:
Kod:
Sub UpCaseChange()
  Dim rng As Range, cel As Range
  On Error Resume Next
  Set rng = Range("A2:I10000").SpecialCells(xlCellTypeConstants, xlTextValues)
  On Error GoTo 0
  If Not rng Is Nothing Then
    For Each cel In rng
      cel.Value = UCase(cel.Value)
    Next cel
  End If
End Sub

Sub UpCaseChange2()
  Dim rng As Range, cel As Range
  On Error Resume Next
  Set rng = Range("A2:I10000").SpecialCells(xlCellTypeConstants, xlTextValues)
  On Error GoTo 0
  If Not rng Is Nothing Then
    For Each cel In rng.Areas
      cel.Value = Evaluate("INDEX(UPPER(" & cel.Address & "),)")
    Next cel
  End If
End Sub

Jeśli dane są zblokowane drugi wariant powinien być szybszy, jeśli bardzo rozdrobnione, to chyba pierwszy. Na załączonym pliku lepiej sprawdza się drugi.

export zostały PLIK_TESTOWY1.xlsm
Pobierz Plik ściągnięto 2 raz(y) 100.44 KB

ID posta: 364152 Skopiuj do schowka
 
 
Klepicki 
Fan Excela



Posty: 66
Wysłany: 13-03-2019, 18:55   

sprawdziłem wszystkie 3 sposoby i faktycznie Sub UpCaseChange2() najszybciej sobie radzi z zmianą danych

Bardzo dziękuje Wam za pomoc :)

Zależy mi w tym pliku na prędkości działania, samo makro działa w tle i w harmonogramie mam pliki vbs ustawione które wysyłają maila a myślące kółko przy moim sposobie potrafiło zawiesić całą operacje.
_________________
pozdr,
Kamil Łępicki
ID posta: 364157 Skopiuj do schowka
 
 
ąćęłńóś
ExcelSpec


Pomógł: 185 razy
Posty: 838
Wysłany: 13-03-2019, 20:42   

Klepicki napisał/a:
Zależy mi w tym pliku na prędkości działania

W takim razie tablica, w pamięci będzie to najszybsze.
Przykładowo:

http://www.excelforum.pl/...lica++pami%EAci
http://www.excelforum.pl/...ghlight=tablice

i wszystko inne w czym wystepują frazy tablice, pamięć, szybkość, itp.

Np.:
Kod:
tbl = Range("A2:I10000").Value

zasysa dane do tablicy z wymaganego obszaru, a później poprzez odwoływanie się do:
Kod:
tbl(w, k) = UCase(tbl(w, k))

można sobie pozamieniać co się chce.
ID posta: 364163 Skopiuj do schowka
 
 
Klepicki 
Fan Excela



Posty: 66
Wysłany: 14-03-2019, 00:14   

o sprawdzę jutro jak będę przy pliku, w sumie nie używałem jeszcze nigdy tablic ale brzmi ciekawie :) warto spróbować
_________________
pozdr,
Kamil Łępicki
ID posta: 364175 Skopiuj do schowka
 
 
ąćęłńóś
ExcelSpec


Pomógł: 185 razy
Posty: 838
Wysłany: 14-03-2019, 01:12   

:-> ... czas najwyżsiejszy z nich skorzystać, np.:
Kod:
Option Explicit

Sub aaa()
    Dim k%, w&, tbl(): tbl = Range("A2:I10000").Value
    For k = 1 To UBound(tbl, 2)
        For w = 1 To UBound(tbl, 1)
            If Len(Trim(tbl(w, k))) > 0 Then
                If Not IsDate(tbl(w, k)) Then
                    If Not IsNumeric(tbl(w, k)) Then tbl(w, k) = UCase(tbl(w, k))
                End If
            End If
        Next
    Next
    Range("A2:I10000").Value = tbl: Erase tbl
End Sub
ID posta: 364179 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe