Question

我有一个以前的同事写的以下代码，我需要帮助修改它。

已加载用户表格，并且用户输入了开始/结束日期。它在Sheet 1中搜索此开始/结束范围内的日期，然后将整个行复制到Sheet2，然后继续在Sheet1中向下搜索匹配的日期。

我需要将其修改为

在Sheet1，Q和S列中搜索日期
在同一行中复制Sheet1，C，G以及日期J和Q的单元格
粘贴到S，Sheet2，A，B和C列中D的行中。

这超出了我的知识水平。任何帮助将不胜感激，因为我似乎无法弄清楚这段代码。如果您可以简单地解释它的工作原理，那将同样棒！

Answer 1

使用此代码，它应该可以工作：

Object.keys(hash).reduce(function(longestKeys, key){
  if(hash[key] > hash[longestKeys[0]]){
    longestKeys.length = 0;
  }

  if(longestKeys.length === 0 || hash[key] === hash[longestKeys[0]]){
    longestKeys.push(key);
  }

  return longestKeys;
}, []);

Answer 2

Since this is an "Excel-as-datasource" problem, I would use an SQL statement for this. Add a reference to Microsoft ActiveX Data Objects 6.1 Library (via Tools -> References...). There may be versions other than 6.1; choose the highest.

Dim pathToExcelFile As String
pathToExcelFile = ActiveWorkbook.Name

Dim cmd As New ADODB.Command
cmd.ActiveConnection = _
    "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=""" & pathToExcelFile & """;" & _
    "Extended Properties=""Excel 12.0;HDR=No"""

'This string defines which data we are retrieving from the source worksheet
'SELECT F3, F7, F10, F17, F19 -- choose the columns C, G, J, Q and S
'FROM [Sheet1$] -- from Sheet1
'WHERE ... -- where F17 (Column Q) is between the start and end date;
'    we'll fill in the values corresponding to the question marks later
'OR ... -- or F19 (Column S) is between the start and end date

cmd.CommandText = _
    "SELECT F3, F7, F10, F17, F19 " & _
    "FROM [Sheet1$] " & _
    "WHERE F17 BETWEEN ? AND ? " & _
       "OR F19 BETWEEN ? AND ?"

Dim startParameter As ADODB.Parameter
Set startParameter = cmd.CreateParameter("StartDate", adDate, adParamInput, , StartDate)

Dim endParameter As ADODB.Parameter
Set endParameter = cmd.CreateParameter("EndDate", adDate, adParamInput, , EndDate)

'We're filling in the question marks here
'1st and 3rd -- start date
'2nd and 4th -- end date
cmd.Paramters.Append startParameter
cmd.Parameters.Append endParameter
cmd.Paramters.Append startParameter
cmd.Parameters.Append endParameter

Dim rs As ADODB.Recordset
Set rs = cmd.Execute

'Paste the resulting data starting from A5
Worksheets("Sheet2").Range("A5").CopyFromRecordset(rs)

References

ActiveX Data Objects

Excel

Excel VBA-搜索日期并将特定的单元格复制到另一张工作表

2 个答案:

References