• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Relativní oblast

Zaslal/a Raders486 30.12.2020 16:59

Ahoj.
Potřeboval bych pomoci s relativní oblasti.

Cyklus prohledává čísla z listu "Data" ze sloupce "N" v listě "Nabídky" ve sloupci "A". Pokud číslo najde, měl by z listu "Nabídky" do listu "Data" nakopírovat všechny buňky od "B" po "BG" z řádku kde se nalezené číslo nachází.

Snažím se využít toto, ale nějak mi to nejde.

Sub Najdi_kopiruj()
Dim Radek As Integer
Dim posledni As Long
posledni = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row

For Radek = 1 To posledni

If Sheets("Data").Range("N" & Radek).Value2 = Sheets("Nabídka").Range("A" & Radek).Value2 Then
Sheets("Nabídka").Range(("B" & Radek), Range("B:BG" & Radek)).Copy

Sheets("Data").Range("BY" & Radek).PasteSpecial xlPasteAll

End If

Next


End Sub

Mohl by mi prosím někdo pomoci? Měla by to být prkotina, ale nějak mi to prostě nejde.

Vzhledem k citlivosti dat, pošlu když tak přílohu do PM.
Děkuji za ochotu a přeji pěkný zbytek svátků.

Zaslat odpověď >

---

Raders486(30.12.2020 17:07)#049296

Už to mám
Sheets("Nabídka").Range(("B" & Radek), Sheets("Nabídka").Range("BG" & Radek)).Copy
citovat

Raders486(30.12.2020 17:26)#049297

Problém je v tom, že se procedura zastaví v okamžiku když se čísla v listě "Data" ve sloupci "N" shodují. Opět nechápu proč když mám zadáno, že má projít celý list.

Potřeboval bych, aby projela všechny řádky a je jedno jestli jsou čísla ve sloupci "N" stejná.

Prostě když je číslo stejné tak budou i stejné nakopírované hodnoty.citovat

elninoslov(30.12.2020 17:45)#049298

Neviem, či Vás chápem ... skúste iný prístup:
Sub Najdi_kopiruj()
Dim RadkuN As Long, RadkuD As Long, i As Long, aFind

Application.ScreenUpdating = False

RadkuD = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
If RadkuD = 1 Then MsgBox "Žádné data.", vbExclamation: Exit Sub

With Worksheets("Nabídka")
RadkuN = .Cells(Rows.Count, 1).End(xlUp).Row
If RadkuN = 1 Then MsgBox "Žádné nabídky.", vbExclamation: Exit Sub

aFind = Evaluate("=IFNA(MATCH('Data'!N2:N" & RadkuD & ",'Nabídka'!A2:A" & RadkuN & ",0),0)")

For i = 1 To RadkuD - 1
If aFind(i, 1) > 0 Then
.Range("B1:BG1").Offset(aFind(i, 1), 0).Copy Worksheets("Data").Cells(i + 1, "BY")
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

A priložte prílohu.

Příloha: 49298_najdi_kopiruj.zip (20kB, staženo 8x)

citovat

elninoslov(30.12.2020 17:53)#049299

Oprava, zabudol som na korekciu v prípade, ak bude kontrolovaný iba 1 riadok, vtedy nevráti Evaluate pole ale iba hodnotu - opravené:
Sub Najdi_kopiruj()
Dim RadkuN As Long, RadkuD As Long, i As Long, aFind

Application.ScreenUpdating = False

RadkuD = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
If RadkuD = 1 Then MsgBox "Žádné data.", vbExclamation: Exit Sub

With Worksheets("Nabídka")
RadkuN = .Cells(Rows.Count, 1).End(xlUp).Row
If RadkuN = 1 Then MsgBox "Žádné nabídky.", vbExclamation: Exit Sub

aFind = Evaluate("=IFNA(MATCH('Data'!N2:N" & RadkuD & ",'Nabídka'!A2:A" & RadkuN & ",0),0)")

If IsArray(aFind) Then
For i = 1 To RadkuD - 1
If aFind(i, 1) > 0 Then .Range("B1:BG1").Offset(aFind(i, 1), 0).Copy Worksheets("Data").Cells(i + 1, "BY")
Next i
Else
If aFind > 0 Then .Range("B2:BG2").Copy Worksheets("Data").Cells(1, "BY")
End If
End With

Application.ScreenUpdating = True
End Sub

Příloha: 49299_najdi_kopiruj.zip (18kB, staženo 7x)

citovat

Raders486(30.12.2020 18:05)#049300

Elninoslov jako vždy jste pochopil správně a kód pracuje na jedničku. Děkuji.

Spíše nechápu proč se mi to zastavilo v okamžiku, když se čísla ve sloupci N shodovala s předešlým řádkem.

Mohl by jste mi objasnit příčinu?

Teď to prosím neberte tak, že bych si chtěl něco vymýšlet a podobně, jsem rád za každou pomoc.
Jde o to, že Vaše kódy jsou pro mě jako začátečníka jednou velkou neznámou a tak by mi hodně pomohlo, pokud by jste mohl provést nápravu v mém kódu, ve kterém se orientuji mnohem lépe.

Jinak děkuji i tak.citovat

elninoslov(30.12.2020 23:40)#049305

Toto máte určite zle technicky:
Sheets("Nabídka").Range(("B" & Radek), Range("B:BG" & Radek)).Copy
má to byť
Sheets("Nabídka").Range("B" & Radek & ":BG" & Radek)
a navyše ak nemajú listy rovnaké údaje na rovnakých riadkoch, tak je to zle aj logicky. Musel by ste použiť 2. cyklus. Keď jeden by bral vždy po jednom DATA a druhý cyklus by pre každý DATA riadok prešiel celú NABIDKA. To je zbytočne pomalé, preto som použil hromadný maticový MATCH/POZVYHLEDAT v Evaluate ("vyhodnocovač vzorcov").

Bola by dobrá príloha, kde by bolo vidieť, či sa jedná o rovnaké riadky, rovnaký počet riadkov, a či je vôbec potrebné kopírovať xlPasteAll, alebo by stačilo iba hodnoty. Ale je pravda, že to by som Vám zase iba skomplikoval kód :)citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse