Stránka 1 z 1
Doplnění některých údajů z listu na list
Napsal: 26 led 2012 07:57
od cmuch
Ahoj,
Chtěl bych poprosit o radu.
Mám dokument ve kterém se do listu1 zadávají údaje, ale k některým údajů není potřeba vypisovat vše.
A na listu2 jsou pomocná data ve kterých je zadáno co se má automaticky vyplnit když se zadá na listu1 nějaké měření.
A já bych potřeboval aby se ty data automaticky přepsali z příslušného řádku listu2 na příslušný řádek listu1
Děkuji za Vaše nápady.
Re: Doplnění některých údajů z listu na list
Napsal: 26 led 2012 08:34
od Azuzula
Chce to trochu upřesnit. Není mi jasné, zda jsou pomocná data stále stejně rozložena jako v demu? Pokud ano, tak by to bylo příliš snadné, takže asi nebudou...
Tak mě napadá že by to šlo makrem přes cyklus a kontrolovat prázdné buňky a doplňovat data z druhého listu do prázdných buněk.
Re: Doplnění některých údajů z listu na list
Napsal: 26 led 2012 09:44
od cmuch
Ano, ty názvy těch sloupcu budou stejne na obou listech.
Udělání přes cyklus mi je také jasné, ale nevím jak mám vyhledat určité měření z listu1 na listu2.
Re: Doplnění některých údajů z listu na list
Napsal: 26 led 2012 11:13
od Azuzula
To měření bude mít nějaký název? Pak by se to dalo hledat podle toho názvu (nebo nějakého ID)
Re: Doplnění některých údajů z listu na list
Napsal: 26 led 2012 12:21
od cmuch
Já potřebuji když se do slupce měrění na listu1 něco napíše aby se zkontroloval sloupec měření na listu2
a pokud je na nějakém řádku ten text z listu1 tak aby se doplnily udaje z listu2 (obsazené bunky na příslušném řádku) na list1.
Re: Doplnění některých údajů z listu na list
Napsal: 26 led 2012 12:56
od Azuzula
To "něco" je něco konkrétního v určité buňce a nebo to je vždy různý zápis v různých buňkách?
Re: Doplnění některých údajů z listu na list
Napsal: 26 led 2012 13:10
od cmuch
to něco bude vždy text co je na listu2 ve sloupci měření, ale může se stát že přibyde text i jiný.
Re: Doplnění některých údajů z listu na list
Napsal: 26 led 2012 14:13
od Azuzula
Ok, budeme se tedy držet sloupce "Měření" jakožto vodítka a zároveň něčeho co můžeme hledat v druhém listu. Zatím bez toho dalšího textu, ale to potom už určitě zvládneš doupravit.
Kód: Vybrat vše
Sub najdi_a_dopln()
Dim data As Variant
Dim bunka1 As Variant
Dim bunka2 As Variant
Dim bunka3 As Variant
Dim bunka4 As Variant
Dim bunka5 As Variant
Dim bunka11 As Variant
Dim bunka12 As Variant
Dim bunka13 As Variant
Dim bunka14 As Variant
Dim bunka15 As Variant
'uloží zapsané hodnoty k porovnání z List1
data = Cells(ActiveCell.Row, 3) 'sloupek 3 "Měření"
'není tedy nutné mít označenou buňku přímo s tím hledaným textem
'stačí označit řádek v kterém budeme hledat
bunka1 = Cells(ActiveCell.Row, 1) 'sloupek 1
bunka2 = Cells(ActiveCell.Row, 2) 'sloupek 2
bunka3 = Cells(ActiveCell.Row, 4) 'sloupek 4
bunka4 = Cells(ActiveCell.Row, 5) 'sloupek 5
bunka5 = Cells(ActiveCell.Row, 6) 'sloupek 6
Sheets("List2").Select
For a = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1 'prohledá každou buňku ve sloupci od spodu
If Cells(a, 3) = data Then
Cells(a, 3).Select
'uloží nalezené hodnoty k porovnání z List2
bunka11 = Cells(ActiveCell.Row, 1)
bunka12 = Cells(ActiveCell.Row, 2)
bunka13 = Cells(ActiveCell.Row, 4)
bunka14 = Cells(ActiveCell.Row, 5)
bunka15 = Cells(ActiveCell.Row, 6)
Sheets("List1").Select
'když bude buňka na List1 prázdná, tak se vloží hodnota z list2
If bunka1 = "" Then Cells(ActiveCell.Row, 1).Value = bunka11
If bunka2 = "" Then Cells(ActiveCell.Row, 2).Value = bunka12
If bunka3 = "" Then Cells(ActiveCell.Row, 4).Value = bunka13
If bunka4 = "" Then Cells(ActiveCell.Row, 5).Value = bunka14
If bunka5 = "" Then Cells(ActiveCell.Row, 6).Value = bunka15
End If
Next a
End Sub
PS: nejsem profík a možná by to šlo i zjednodušit, ale nevím jak. Ale funguje to snad tak jak je třeba.
Re: Doplnění některých údajů z listu na list Vyřešeno
Napsal: 30 led 2012 19:50
od cmuch
Ahoj,
děkuji za makro, ale není to přesně ono.
Zplodil jsem to co by bylo lepší, ale nejde mi nějak udělat aby to kopírovalo z listu na list, asi mám někde chybu
Mám to umístěné na
list1Kód: Vybrat vše
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SRow As Range, CRow As Range
Dim RCll As Integer
Dim NmMereni As String
Dim a As Integer
Dim Cll2 As Range
Dim RCll2 As Integer, CCll2 As Integer
'test vyberu bunky
If Not Intersect(Target, Me.Range("A:F")) Is Nothing Then
' zdrojovy radek
Set SRow = Me.Range("A1:F1").Offset(Target.Row - 1, 0)
RCll = SRow.Row
' nazev
NmMereni = SRow.Columns(3).Value
For a = Sheets("List2").Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1 'prohledá každou buòku ve sloupci od spodu
If Sheets("List2").Cells(a, 3) = NmMereni Then
Set CRow = Sheets("List2").Range("A" & a & ":F" & a)
' zjistit, zda se ma neco prepsat
For Each Cll2 In CRow.Cells
If Not IsEmpty(Cll2) Then
CCll2 = Cll2.Column
RCll2 = Cll2.Row
'toto nevim jak napsat
Sheets("List1").Cells(CCll2 & RCll) = Cll2
End If
Next Cll2
Set Cll2 = Nothing
End If
Next a
End If
End Sub
Děkuji za popostrčení.
--- Doplnění předchozího příspěvku (30 Led 2012 20:05) ---
Tak jsem to vyřešil
toto:
Kód: Vybrat vše
'toto nevim jak napsat
Sheets("List1").Cells(CCll2 & RCll) = Cll2
jsem nahradil timto:
Kód: Vybrat vše
'toto nevim jak napsat
Application.EnableEvents = False
Sheets("List1").Cells(RCll, CCll2) = Cll2
Application.EnableEvents = Truejak je vidět v zápisu jsem měl chybu jak hrom
