2009-07-15 14 views
9

हाय, मैं एक मैक्रो बनाने की कोशिश कर रहा हूं जिसमें एक लूप है जो प्रत्येक स्टेशन के लिए कॉलम 1 (वीओएल) और एक अन्य फ़ंक्शन कॉलम 2 (कैपेसिटी) को कॉपी करता है। यह वही है मैं अब तक है:एक्सेल में पंक्तियों के कॉलम के माध्यम से लूप कैसे करें वीबीए मैक्रो

Sub TieOut() 
    Dim i As Integer 
    Dim j As Integer 

    For i = 1 To 3 
     For j = 1 To 3 
      Worksheets("TieOut").Cells(i, j).Value = "'=INDEX('ZaiNet Data'!$A$1:$H$39038,MATCH('INDEX-MATCH'!Z$7&TEXT('INDEX-MATCH'!$A9,"m/dd/yyyy"),'ZaiNet Data'!$C$1:$C$39038,0), 4)" 
     Next j 
    Next i 

End Sub 

जो मैं चाहता की तस्वीर के नीचे है: आप देख सकते हैं कि मैं मैन्युअल रूप से नकल की और प्रत्येक स्तंभ नीचे मेरी दो कार्य चिपकाया है। मुझे सिर्फ एक मैक्रो की आवश्यकता है जो इसके माध्यम से लूप कर सके।

alt text http://i26.tinypic.com/nz4lfn.jpg

समारोह मैं प्रत्येक स्टेशन के लिए वॉल्यूम स्तंभ नीचे लूप में चलाए जा करना चाहते है:

=INDEX('ZaiNet Data'!$A$1:$H$39038,MATCH('INDEX-MATCH'!Z$7&TEXT('INDEX-MATCH'!$A438,"M/DD/YYYY"),'ZaiNet Data'!$C$1:$C$39038,0), 4) 

समारोह मैं चाहता हूँ प्रत्येक स्टेशन के लिए क्षमता स्तंभ है नीचे लूप में चलाया जा करने के लिए :

=INDEX('ZaiNet Data'!$A$1:$H$39038,MATCH('INDEX-MATCH'!Z$7&TEXT('INDEX-MATCH'!$A438,"M/DD/YYYY"),'ZaiNet Data'!$C$1:$C$39038,0), 5) 

कोई व्यक्ति पी मदद पट्टे? धन्यवाद!

अद्यतन

**** मैं कैसे पाश रन स्वचालित रूप से मैन्युअल रूप से पहले दो कक्षों में सूत्र दर्ज करें और मैक्रो पर क्लिक किए बिना कर सकते हैं?
इसके अलावा मैं कैसे सभी स्तंभों/पंक्तियों के माध्यम से लूप रन बना सकते हैं? (Horizontically) ****

मैं दो स्क्रीन शॉट्स दिखाने के लिए मैं क्या मतलब शामिल थे। नीचे मेरा वर्तमान कोड है। alt text http://i26.tinypic.com/i3gw9g.jpg alt text http://i29.tinypic.com/8izl.jpg धन्यवाद!

Sub Loop3() 
    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(-1, 1).Select 
    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(0, -1).Select 

    Dim i As Integer 
    Dim j As Integer 
     With Worksheets("Loop") 
      i = 1 
      Do Until .Cells(10, i).Value = "blank" 
       For j = 1 To 10 
        .Cells(j, i).Formula = "=INDEX('ZAINET DATA'!$A$1:$H$39038,MATCH(Loop!E$7&TEXT(Loop!$A9,""M/D/YYYY""),'ZAINET DATA'!$C$1:$C$39038,0),4)" 
        .Cells(j, i + 1).Formula = "=INDEX('ZAINET DATA'!$A$1:$H$39038,MATCH(Loop!E$7&TEXT(Loop!$A9,""M/D/YYYY""),'ZAINET DATA'!$C$1:$C$39038,0),5)" 
       Next j 
       i = i + 2 
      Loop 
    End With 

    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(-1, 1).Select 
    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(0, -1).Select 

End Sub 
+0

@ Techgirl09, आप अभी भी इस प्रश्न का अनुसरण कर रहे हैं, मैं वहाँ यह करने के लिए एक आसान तरीका है पता है। 2 प्रश्न: क्या वह सीमा है जो फॉर्मूला की हमेशा एक ही प्रतिलिपि बनाई गई है (यानी क्या आप इसे नामित श्रेणी बना सकते हैं)? और क्या आप इसे शीट सक्रियण, या कुछ और पर ट्रिगर करना चाहते हैं? –

+6

ऐसा लगता है कि केविन ने स्क्रीनशॉट लेते समय आपको एक ईमेल भेजा है, कृपया उसे जवाब दें –

उत्तर

1

इस प्रयास करें:

निम्नलिखित बात अंदर के साथ एक मैक्रो बनाएं:

Selection.Copy 
ActiveCell.Offset(1, 0).Select 
ActiveSheet.Paste 
ActiveCell.Offset(-1, 1).Select 
Selection.Copy 
ActiveCell.Offset(1, 0).Select 
ActiveSheet.Paste 
ActiveCell.Offset(0, -1).Select 

कि विशेष मैक्रो वर्तमान कक्ष की प्रतिलिपि बनाएगा (वॉल्यूम सेल में अपना कर्सर रखें आप कॉपी करना चाहते) नीचे एक पंक्ति और फिर कैप सेल भी कॉपी।

यह केवल एक ही लूप है ताकि आप वीओएल और सीएपी की प्रतिलिपि स्वचालित कर सकें जहां आपका वर्तमान सक्रिय सेल (जहां आपका कर्सर है) 1 पंक्ति से नीचे।

बस एक पाश के लिए बयान के अंदर डाल दिया यह समय की संख्या x क्या करना है। चाहते:

Dim i As integer, j as integer 

With Worksheets("TimeOut") 
    i = 26 
    Do Until .Cells(8, i).Value = "" 
     For j = 9 to 100 ' I do not know how many rows you will need it.' 
      .Cells(j, i).Formula = "YourVolFormulaHere" 
      .Cells(j, i + 1).Formula = "YourCapFormulaHere" 
     Next j 

     i = i + 2 
    Loop 
End With 
+0

धन्यवाद! मुझे यह काम मिल गया। अब मुझे लूप की आवश्यकता है जब तक कि मेरे बाएं तरफ कॉलम (दिनांक सीमा) खाली न हो। मैं देखता हूं कि मैं यह कैसे कर सकता हूं - अगर कोई इनपुट कर सकता है - तो इसकी सराहना होगी। – Techgirl09

+1

सक्रिय सेल को बदलने से कोड बहुत धीमा हो जाता है। – Wilhelm

5

यहाँ मेरी sugestion है

rngSource.AutoFill Destination:=rngDest 

कि मान स्रोत श्रेणी निर्दिष्ट करें या सूत्रों आप नीचे भरने के लिए चाहते हैं, और पूरी श्रृंखला के रूप में गंतव्य सीमा है कि आप करने के लिए भरा कोशिकाओं चाहते हैं।गंतव्य सीमा में स्रोत सीमा शामिल होनी चाहिए। आप साथ ही साथ भर सकते हैं।

यह वैसे ही काम करता है जैसे कि यदि आप मैन्युअल रूप से माउस के साथ कोने पर कोशिकाओं को "खींचा" करते हैं; absolute and relative formulas अपेक्षा के अनुसार काम करते हैं।

'Set some example values' 
Range("A1").Value = "1" 
Range("B1").Formula = "=NOW()" 
Range("C1").Formula = "=B1+A1" 

'AutoFill the values/formulas to row 20' 
Range("A1:C1").AutoFill Destination:=Range("A1:C20") 

आशा इस मदद करता है:

यहाँ एक उदाहरण है।

+0

धन्यवाद - जो कोशिकाओं के माध्यम से मेरे सूत्र को कॉपी और पेस्ट किया गया है लेकिन इसके लिए इसे करने के लिए, मुझे पहले दो कक्षों में सूत्र को मैन्युअल रूप से दर्ज करना होगा और फिर मैक्रो पर क्लिक करना होगा। क्या इसे पूरी तरह से स्वचालित बनाने का कोई तरीका है? उदाहरण के लिए यदि तीसरी स्टेशन में मेरी शीट पूरी तरह खाली है, तो फॉर्मूला स्वचालित रूप से कैसे पॉप्युलेट हो सकता है? – Techgirl09

+0

जस्टे कोड के साथ फॉर्मूला सूत्र संपत्ति पर लिखा गया है, इसकी प्रतिलिपि नहीं बनाई गई है। पहले दो कोशिकाओं में सूत्र लिखने की कोई आवश्यकता नहीं है। – Wilhelm

0

मैं सलाह देते हैं रेंज वस्तु की इस बात के लिए AutoFillmethod:

For i = 1 to 100 'Do this 100 times 
    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(-1, 1).Select 
    Selection.Copy 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(0, -1).Select 
Next i 
1

यह एक @ विल्हेम के समाधान के समान है। लूप जनसंख्या वाले दिनांक कॉलम का मूल्यांकन करके बनाई गई सीमा के आधार पर स्वचालित करता है। यह बातचीत और स्क्रीनशॉट पर बातचीत के आधार पर एक साथ थप्पड़ मारा गया था।

कृपया ध्यान दें: यह मानता है कि शीर्षलेख हमेशा एक ही पंक्ति (पंक्ति 8) पर होंगे। डेटा की पहली पंक्ति को बदलना (हेडर ऊपर/नीचे ले जाना) सीमा स्वचालन को तब तक तोड़ने का कारण बनता है जब तक कि आप डायरेक्टर पंक्ति को गतिशील रूप से लेने के लिए रेंज ब्लॉक संपादित नहीं करते। अन्य धारणाओं में शामिल हैं कि वीओएल और कैपेसिटी फॉर्मूला कॉलम हेडर क्रमशः "वॉल्यूम" और "कैप" नामित हैं।

Sub Loop3() 

Dim dtCnt As Long 
Dim rng As Range 
Dim frmlas() As String 

Application.ScreenUpdating = False 

'The following code block sets up the formula output range 
dtCnt = Sheets("Loop").Range("A1048576").End(xlUp).Row    'lowest date column populated 
endHead = Sheets("Loop").Range("XFD8").End(xlToLeft).Column   'right most header populated 
Set rng = Sheets("Loop").Range(Cells(9, 2), Cells(dtCnt, endHead)) 'assigns range for automation 

ReDim frmlas(1)  'array assigned to formula strings 
    'VOL column formula 
frmlas(0) = "VOL FORMULA" 
    'CAPACITY column formula 
frmlas(1) = "CAP FORMULA" 

For i = 1 To rng.Columns.count 
If rng(0, i).Value = "Vol" Then   'checks for volume formula column 
    For j = 1 To rng.Rows.count 
     rng(j, i).Formula= frmlas(0) 'inserts volume formula 
    Next j 
ElseIf rng(0, i).Value = "Cap" Then  'checks for capacity formula column 
    For j = 1 To rng.Rows.count 
     rng(j, i).Formula = frmlas(1) 'inserts capacity formula 
    Next j 
End If 
Next i 

Application.ScreenUpdating = True 

End Sub 
संबंधित मुद्दे