VBA /macros突然停止正常工作
我有一个奇怪的问题。 一切正常，直到我使用另一个原始数据文件，并将其命名为Raw Data_Park Sampling.xlsx 。 运行我的代码后，没有错误，但没有任何被复制到“随机样本”表。
奇怪的是，新的原始数据文件与前一个文件具有相同的内容。
我试图replace以前的工作文件内的数据，它仍然工作。 我不知道为什么我的代码将只工作，如果我使用特定的原始数据文件。 这是为什么？ 即使我改名为其他文件： Raw Data_Park Sampling.xlsx并具有相同的内容/格式，它不工作。
我已经尝试创build另一个Excel文件并粘贴代码，但仍然没有运气。 我真的不知道为什么这种事情甚至发生。 哪里不对？
以下是我的整个代码：
Sub MAINx1() 'Delete current random sample Sheets("Random Sample").Select Cells.Select Range("C14").Activate Selection.Delete Shift:=xlUp 'copy header Windows("Raw Data_Park Sampling.xlsx").Activate Range("A1:L1").Select Selection.Copy Windows("Park Sampling Tool.xlsm").Activate Range("A1").Select ActiveSheet.Paste Dim rawDataWs As Worksheet, randomSampleWs As Worksheet Dim map, i As Long, n As Long, c As Long, rand, col Dim keyArr, nRowsArr Dim rng As Range Set rawDataWs = Workbooks("Raw Data_Park Sampling.xlsx").Worksheets("Sheet1") Set randomSampleWs = Workbooks("Park Sampling Tool.xlsm").Worksheets("Random Sample") randomSampleWs.UsedRange.ClearContents Set rng = rawDataWs.Range("A2:A" & _ rawDataWs.Cells(Rows.Count, 1).End(xlUp).Row) Set map = RowMap(rng) keyArr = Array("AU", "FJ", "NC", "NZ", "SG12", "ID", "PH26", "PH24", "TH", "ZA", "JP", "MY", "PH", "SG", "VN") '<== keywords nRowsArr = Array(4, 1, 1, 3, 1, 3, 3, 1, 3, 4, 2, 3, 1, 3, 2) '<== # of random rows Debug.Print "Key", "#", "Row#" For i = LBound(keyArr) To UBound(keyArr) If map.exists(keyArr(i)) Then Set col = map(keyArr(i)) n = nRowsArr(i) For c = 1 To n 'select a random member of the collection rand = Application.Evaluate("RANDBETWEEN(1," & col.Count & ")") Debug.Print keyArr(i), rand, col(rand) rawDataWs.Rows(col(rand)).Copy _ randomSampleWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) col.Remove rand 'remove the "used" row If col.Count = 0 Then If c < n Then Debug.Print "Not enough rows for " & keyArr(i) Exit For End If Next c Else Debug.Print "No rows for " & keyArr(i) End If Next i MsgBox "Random Sample: Per Day Successfully Generated!" End Sub 'get a map of rows as a dictionary where each value is a collection of row numbers Function RowMap(rng As Range) As Object Dim dict, c As Range, k Set dict = CreateObject("scripting.dictionary") For Each c In rng.Cells k = Trim(c.value) If Len(k) > 0 Then If Not dict.exists(k) Then dict.Add k, New Collection dict(k).Add c.Row End If Next c Set RowMap = dict End Function
在代码中打开工作簿，然后设置参考：
Sub MAINx1() Dim rawDataWB As Excel.Workbook Dim randomSampleWB As Excel.Workbook Dim rawDataWS As Excel.Worksheet Dim randomSampleWS As Excel.Worksheet Dim rd As String Dim rs As String MsgBox "Select the raw data workbook", vbInformation rd = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx") MsgBox "Select the random sample workbook", vbInformation rs = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx") If UCase$(rd) <> "FALSE" And UCase$(rs) <> "FALSE" Then Set rawDataWB = Workbooks.Open(rd) Set randomSampleWB = Workbooks.Open(rs) Else Exit Sub End If Set rawDataWS = rawDataWB.Sheets("Sheet1") Set randomSampleWS = randomSampleWB.Sheets("Random Sample") '// Delete current random sample randomSampleWS.ClearContents '// Copy header randomSampleWS.Range("A1:L1").Value = rawDataWS.Range("A1:L1").Value Dim map, i As Long, n As Long, c As Long, rand, col Dim keyArr, nRowsArr Dim rng As Range '// rest of your code here ... End Sub
macros在xlsx文件中不起作用，将其保存在xlsm中。