按条件排序

风云驿

如果货品简称和颜色数值相同,则按尺码数排序的代码怎样写啊

如果货品简称和颜色数值相同,则按尺数排序,想写这个代码,但一直不成功,请教大家,我的代码如下:Sub 排序2()  Dim arr, i, j, k, t, s, ar
  arr = [a1].CurrentRegion
  For i = LBound(arr) To UBound(arr) - 1
  For j = (i + 1) To UBound(arr)
  For s = 1 To UBound(arr, 2)
  ar = Range(Cells(i, 1), Cells(i, s))

If Cells(i, 1) = Cells(j, 1) And Cells(i, 3) = Cells(j, 3) And Cells(j, 4) > Cells(i, 4) Then
k = ar(i, s): ar(i, s) = ar(j, s): ar(j, s) = k

            End If

            Next
           Next
      Next

[a10].Resize(UBound(arr), 4) = ar
End Sub

网海遨游

试试这句
sub 排序
range("a1:d" & [a65536].end(3).row).sort [b1],2,,[c1],2,[d1],2
end sub

风云驿

网海遨游 发表于 2019-10-12 14:44
试试这句
sub 排序
range("a1:d" & [a65536].end(3).row).sort ,2,,[c1],2,[d1],2

结果不对,其实我这个数据列有很多,只是截取其中一小部分测试,想有个终极的解决办法,谢谢

网海遨游

风云驿 发表于 2019-10-12 14:53
结果不对,其实我这个数据列有很多,只是截取其中一小部分测试,想有个终极的解决办法,谢谢

你上传个附件，有附件才能有真相。

风云驿

谢谢,附件附上

月关

[a1].CurrentRegion.Sort key1:=[j1], key2:=[l1], Header:=yes

如果 货品简称 和 尺数 列位置有变动，动态捕获即可，替换上述相应的 j1 和 l1

月关

‘把原附件中下面的示例结果先删掉，要不然会出现混乱
Sub test2()
Set cnn = CreateObject("adodb.connection")
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes;IMEX=0';Data Source=" & ThisWorkbook.FullName
Sql = "select * from [sheet1$] order by 货品简称,颜色,尺数"
[a2].CopyFromRecordset cnn.Execute(Sql)
cnn.Close
Set cnn = Nothing
End Sub


仔细看了一下，用sort不会排序尽数为00的，SQL不会出现这个现象，但是会把00直接删除

月关

总体来说，SQL执行的结果完全满足要求，删掉的尺数为 00 的，手动或者用代码加上即可（如果需要的话）

风云驿

月关 发表于 2019-10-12 16:30
总体来说，SQL执行的结果完全满足要求，删掉的尺数为 00 的，手动或者用代码加上即可（如果需要的话）

谢谢,差不多是这个意思,之前也看了你写的字典嵌套,很是了不起,
我看了下结果,第7列有的是空白,不知道是什么原因,另外00的是会删除不能避免吗?

月关

风云驿 发表于 2019-10-12 16:49
谢谢,差不多是这个意思,之前也看了你写的字典嵌套,很是了不起,
我看了下结果,第7列有的是空白,不知道是 ...

很奇怪，你不说我都没细看。
—— SQL只是告诉它想要的结果，然后不知道内部什么运算机制。把部分商家编码给删掉有点莫名其妙。。。
如果说最后一列尺数的00可以想想办法的话，商家编码这块儿我是完全没有头绪。。。
这条路走不通了。。。sort的话倒是可以用个笨办法搞定，我想的是先sort再回找 ^)^
老师们肯定有方法，我也跟着一块儿学一学