Kopiera data till rätt plats i en mall

[qvista]

Hej,

 

Har länge framgångsrikt letat tips här men nu behöver jag mer avancerad VBA hjälp.

 

Jag har data i Excel-blad som jag vill klippa in i en färdig mall som innehåller grafer och andra uträkningar. Problemet är bara att jag inte det exakt vilka variabler som finns i databladet. Mallen innehåller de värden som är intressanta men det kan finnas fler variabler som inte skall flyttas.

 

Min planerade lösning på problemet är att läsa in varje rubrik, som står överst i alla kolumner, lagra namnet, kopiera all data i aktuell kolumn, växla till mallen, söka efter det lagrade namnet och sedan klistra in datan. Sedan gå tillbaka till databladet och läsa in nästa rubrik och upprepa till sista rubriken.

Om rubriken inte finns i mallen skall den datan kastas och nästa rubrik läsas in osv.

 

Har en äldre, "fulare" version av detta macro som helt enkelt söker (spelat in koden för find) efter de variabler jag vill ha med, kopierar, växlar till mallen, söker efter variabeln och klistrar in. Detta sköts utan loop vilket gör storleken på koden för stor (går ej att köra) om jag har många variabler.

 

Så det jag behöver hjälp med är själva loopen samt hur man läser in och lagrar värden för att sedan söka efter dem i ett annat excel-blad.

Använder engelskt Excel om det spelar nån roll.

 

Tack på förhand

Andreas

[Monshi]

Utan att se ett exempel på vad du har och vad du vill ha är det lite svårt att säga något exakt.

 

men generellt är mitt råd att se om du inte via formler kan samla ihop dina data i de strukturer som ska in i mallen och sedan via relativt enkel kod kopiera in delarna på rätt plats?

 

Kanske inte applicerbart i detta fall?

 

Till det du skriver, kanske kan reda ut lite.

Du har alltså en mall med nycklar (rubriker), du har data i en tabell med fler kolumner än mallen vill ha.

 

jag skulle lägga upp det som

1: Stega genom rubrikerna i mallen

2: Skapa en funktion som tar som inargument en rubrik och som resultat returnerar en kolumn/de celler där data som ska in på mallen finns eller om rubriken inte finns ingenting (Nothing).

2 b: Denna funktion söker då förslagsvis med Find i rubrikerna på bladet. Om den hittar något tar den reda på hur många värden det finns och returnerar sedan området.

3: Din stegfunktion tar då referensen, om det får en tillbaka, kopierar värdena där och klistrar in på rätt plats i mallen.

 

Låter det rimligt/möjligt för dig att skapa?

[qvista]

Tack för snabbt svar, ska titta på det imorgon.

 

Mer utförligare förklaring av problemet;

 

Databladet ser ut så här fast med mkt fler rader och kolumner:

 

Date Time Speed Torque

Date Time rpm Nm

2010-04-02 09:01:42 950,0 15

2010-04-02 09:01:43 947,5 18

 

 

Mallen har bara rubrikerna färdiga, samt länkar till grafer.

 

 

 

Min kod jag har nu ser ut så här

 

ActiveWorkbook.SaveAs Filename:="M:\TC13\MVEG Temp folder\temp.xls", _
	FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
	ReadOnlyRecommended:=False, CreateBackup:=False 	' Byter namn på grundfilen för att kunna växla filer.


Workbooks.Open Filename:= _
	"M:\TC13\Temp folder\TC13 Template.xls" 	' öppnar mallen


' *** Kod för en variabel ***
Cells.Find(What:="Date", After:=ActiveCell, LookIn:=xlFormulas, _
	LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
	MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(2, 0).Select 	' Rad 1 och två skall inte med innehåller namn samt enhet, finns redan i mallen
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("TC13 Template.xls").Activate
Cells.Find(What:="Date", After:=ActiveCell, LookIn:=xlFormulas, _
	LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
	MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(2, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A3").Select
Windows("Temp.xls").Activate
Application.CutCopyMode = False
Range("A3").Select
' ***

' osv för alla variabler

 

Nu vill jag alltså ersätta den koden med en loop som gör samma sak.

 

Min tanke var så här:

 

Do until active cell = " "

Läs av rubrik på A1

Sätt rubrik = x

offset två steg ned

copy

byt blad till mall

sök efter x

offset två steg ned

klistar in

next cell

Loop

 

Som säkert märks är jag inte jättebra på VBA, mest självlärd.

 

Tack på förhand igen.

Andreas

[Monshi]

Mmh, jag skulle som sagt göra något i stil med

 

Function GetData(name As String) As Range
Dim c As Range
With Blad1.Rows(1)
	Set c = .Find(what:=name)
	If c Is Nothing Then
	Set GetData = Nothing
	Else
	Set GetData = c.Offset(1).Resize(c.Offset(1).End(xlDown).Row - c.row, 1)
	End If
End With
End Function

 

där då GetData söker efter givna sträng i en känd rubrikrad (hela rad 1 på blad1 i detta exempel) och returnerar området med data under rubriken.

 

Och sedan en loopande rutin:

Sub MyDataCopier()
Dim rnHeads As Range
Dim rnSource As Range
Dim myCell As Range
Set rnHeads = Blad2.Range("A2:B2") ' rubrikerna i mallen
For Each myCell In rnHeads
	Set rnSource = GetData(myCell.Text)
	If Not rnSource Is Nothing Then
	rnSource.Copy
	myCell.Offset(1).PasteSpecial xlPasteValues
	End If
Next myCell
Application.CutCopyMode = False
End Sub

 

Anpassa referenserna och kanske lite mer, sedan borde det fungera för dig.