複製並粘貼到vba

我有一個Excel VBA編碼問題。複製並粘貼到vba

我想使一個編碼可以在一定條件下將數據從一張紙複製到一張紙上。我的數據在二進制表單中。

sheet1中的數據有近千行。我只是想從sheet1到sheet 2中隨機抽取15行數據。必須滿足的條件是每列只有列的總和爲3.如果不滿足，則將採取其他數據。

當我點擊生成。它將從數據表1複製到表2.我希望我的數據副本像紅圈一樣。不像紅色的那一列。請幫我

Option Explicit 
Sub Random20() 
Randomize 
Dim MyRows() As Integer  
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer 
'Determine Number of Rows in Sheet1 Column A 
    numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row 

    percRows = 17 

    ReDim MyRows(percRows) 
'Create Random numbers and fill array 
    For nxtRow = 1 To percRows 
getNew: 
'Generate Random number 
     nxtRnd = Int((numRows) * Rnd + 1) 
'Loop through array, checking for Duplicates 
     For chkRnd = 1 To nxtRow 
'Get new number if Duplicate is found 
     If MyRows(chkRnd) = nxtRnd Then GoTo getNew 
     Next 
'Add element if Random number is unique 
     MyRows(nxtRow) = nxtRnd 
    Next 
'Loop through Array, copying rows to Sheet2 
    For copyRow = 1 To percRows 
    Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _ 
    Destination:=Sheets(2).Cells(copyRow, 1) 
    Next 
End Sub

來源

2016-10-26 Jai Wilshere

你有什麼試過自己？向我們展示您迄今爲止編寫的任何代碼，以便我們提供幫助。 SO不是一種編碼服務。 – rohrl77

完成看看 –

你想要所有的列共3？或任何單列？每行有多少列數據？所有我能想到的將是一個精神上長的公式，用雙重循環來檢查每一列的總數。 –

這將實現你在找什麼，但代碼將需要很長的時間來執行，我居然嘲笑了配方，使用RANDBETWEEN(1,COUNTIF(Sheet1!A:A,"<>"&""))和RandBetweenInt(1,COUNTIF(Sheet1!A:A,"<>"&""),***Range of Random Integers from above***)（用戶定義函數發現here）模仿你的代碼。這個計算速度要快得多，不包括重複的隨機數字。

Sub chkRand() 

Application.Calculation = xlCalculationManual 

Do Until Worksheets("Sheet3").Range("I18").Value = 1 
Application.Calculate 
Loop 

End Sub

.Range("I18")具有式=IF(COUNTIF(B18:H18,3)=7,1,0)所以這將迫使手工計算和然後重新計算，直到所有的總列3

警惕，雖然我已經離開了30分鐘這個宏的運行，現在，它仍然不是招」 t找到了一場比賽。

只是在情況下，你真的想找我會用VBA唯一的解決辦法：

For Clm = 2 To 8 
ClmTtl = 0 
    For copyRow = 1 To percRows 
    ClmTtl = ClmTtl + Sheets(1).Cells(MyRows(copyRow), clm).Value 
    Next 
    If Not ClmTtl = 3 Then Call Random20 
Next

雖然我總是建議先尋求一個基於公式的解決方案，並且只使用在需要它們的宏。

因爲這隻能在前一個總數爲3時進入下一列，所以只有當它們全部達到期望總數時代碼才能完成。希望這有助於減少運行時間。

來源

2016-10-27 10:31:09

複製並粘貼到vba

回答

相關問題