-
GAMEPOD.hu
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
wjani
tag
válasz core1113 #5035 üzenetére
Szia itt a kód:
Sub átemelés()
'
' átemelés Makró
'
'=========================================================================================
'Ez a makró egy adott oldal első oszlopának adatait emeli át egy mások munkalapra úgy, hogy
'az első oszlop eslő értéke az első oszlopba, az első oszlop második sorának értéke a
'a második oszlopba, az első oszlop harmadik értéke a harmadik oszlopba kerül.
'
'A zárójelben Munka1 és Munka2 értékeket cseréld le a te munkalapjaid nevére, de pontosan
'Készítette: Weisz János, wjani@freemail.hu
'=========================================================================================
'Első és második munkafüzet változóinak felvétele,
Dim i, j As Variant
'A sor változók megadása
Dim s, o, m, n As Integer
'A sor kezdő értékeinek megadása
s = 1
o = 1
m = 1
n = 1
' Egy ciklus ami addig megy, amíg az első munkalapon az első üres sort nem talál
Do
' Az első érték felvétele a változóba
i = Worksheets("Munka1").Cells(s, o).Value
' Ez a ciklus második oldalon fogja az adatokat átadni
Do
'Az első érték felvétele a változóba
j = Worksheets("Munka2").Cells(m, n).Value
'Ha az első cella értéke üres, tegye bele az értékeket a megadott cellákba
If j = Empty Then
'első cella értéke legyen egyenlő az első cella értékével
Worksheets("Munka2").Cells(m, n).Value = Worksheets("Munka1").Cells(s, o).Value
'második cella értéke legyen egyenlő a második sor első cellájának értékével
Worksheets("Munka2").Cells(m, n + 1).Value = Worksheets("Munka1").Cells(s + 1, o).Value
'harmadik cella értéke legyen egyenlő a harmadik sor első cewllájának értékével.
Worksheets("Munka2").Cells(m, n + 2).Value = Worksheets("Munka1").Cells(s + 2, o).Value
'lépjen ki a ciklusból
Exit Do
'Ha a cella értéke nem üres
Else
'A második lap első oszlopában ugorjon a következő sorba
m = m + 1
'Feltétel vége
End If
' Addig fusson a ciklus, amíg a második lap első oszlopának a sorában üres nem lesz a cella
Loop Until j = Empty
'Első munkalap első oszlopában ugorjon 3 cellával lejebb
s = s + 3
Loop Until i = Empty
'Üzenet ha a feladatot végrehajtotta
MsgBox "Az adatok átemelése megtörtént", vbInformation, "Üzenet a feladat végrehajtásáról!"
End SubEz tedd bele abba a makróba, amit létrehozól.
A makró elején leírtam, hogy mit csinál, minden részre odaírtam a magyarázót.
Ha valamit nem megy, vagy nem érted jelezz.
ÜdvWjani
CoViA Online könyvkereskedés,
Új hozzászólás Aktív témák
- Crypto Trade
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- Formula-1
- Politika
- Huawei P30 Pro - teletalálat
- Kodi és kiegészítői magyar nyelvű online tartalmakhoz (Linux, Windows)
- Megbírságolták a Razert a Zephyr maszkok miatt
- A fociról könnyedén, egy baráti társaságban
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Anglia - élmények, tapasztalatok
- További aktív témák...
- PC JÁTÉKOK (OLCSÓ STEAM, EA , UPLAY KULCSOK ÉS SOKMINDEN MÁS IS 100% GARANCIA )
- Adobe Creative Cloud - 2024. 04. 05 - 2025. 04. 05-ig
- Warhammer Online - Age of Reckoning (DE) Collectors Box (Figurával!)
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! LEGOLCSÓBB! Automatikus 0-24
- Bitdefender Total Security 3év/3eszköz! - "Tökéletes védelem most kedvező áron..."
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Promenade Publishing House Kft.
Város: Budapest