Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2061|回复: 9

VBA 程式修改(跳过栏位)

[复制链接]
发表于 2018-7-17 12:32 | 显示全部楼层 |阅读模式
本帖最后由 lkk0063 于 2018-7-17 12:34 编辑

是否可协助修改VBA 程式(跳过M2 & W栏位)
程式执行说明:
当按下Output "Find" 执行案键,跳过M2 & W栏位

095001zad5svd87zt88ado.jpg

  1. Private Sub Sel(xstr)
  2.     Dim i, j, jj, k, x, l, m, lotno
  3.     Dim ToRange As Range
  4.     Dim tmpArr(), n(), Arr
  5.     With Worksheets(1)
  6.         Arr = .Range("a1:bl" & .[A65536].End(3).Row)
  7.     End With
  8.     With ActiveSheet
  9.         Set ToRange = .Range("F3:J23")
  10.         ReDim tmpArr(1 To ToRange.Rows.Count, 1 To 5)
  11.         ReDim n(1 To ToRange.Rows.Count)
  12.         ToRange.ClearContents: .[G1] = ""
  13.         xrr = Split(xstr, ",")
  14.         For i = 6 To UBound(Arr)
  15.             lotno = Arr(i, 1)
  16.             part1 = Left(lotno, 13)
  17.             For Each x In xrr
  18.                 If lotno = x Then
  19.                     .Range("G1") = lotno
  20.                      For j = 5 To 61 Step 3
  21.                         k = (j - 2) / 3
  22.                         For jj = 0 To 2
  23.                              If j + jj <= 61 Then
  24.                                 If Trim(Arr(i, j + jj)) <> "" Then
  25.                                     n(k) = n(k) + 1
  26.                                     If n(k) <= 5 Then tmpArr(k, n(k)) = Arr(i, j + jj)
  27.                                     'ElseIf n(k) = 2 Then tmpArr(k, n(k)) = Arr(i, j + jj)
  28.                                     'ElseIf n(k) = 1 Then tmpArr(k, n(k)) = Arr(i, j + jj)
  29.                                     
  30.                                 End If
  31.                             End If
  32.                         Next jj
  33.                     Next j
  34.                 End If
  35.                  part2 = Left(x, 13)
  36.                 If part1 = part2 Then If InStr(l2, Arr(i, 64)) = 0 Then l2 = l2 & "," & Arr(i, 64)
  37.             Next
  38.         Next i
  39.         ToRange = tmpArr
  40.         .[l2] = Mid(l2, 2)
  41.     End With
  42. End Sub
复制代码

test.zip

559.4 KB, 下载次数: 3

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2018-7-22 22:43 | 显示全部楼层
test.rar (333.91 KB, 下载次数: 14)
回复

使用道具 举报

 楼主| 发表于 2018-7-23 14:34 | 显示全部楼层

你好,
谢谢大大协助帮忙, 但我的需求为(不是针对单一选项, 是针对选取所需的批号):
当按下Output "Find" 执行案键, 选取所需的批号后,A1 ~ M1 & Q & P (最多累积到5笔, 只抓取前5笔资料)跳过 "M2 & W栏位"

1.jpg
回复

使用道具 举报

发表于 2018-7-31 19:00 | 显示全部楼层
你模拟一个结果看看
回复

使用道具 举报

发表于 2018-7-31 20:18 | 显示全部楼层
test2.rar (285.91 KB, 下载次数: 28)
回复

使用道具 举报

 楼主| 发表于 2018-8-1 16:07 | 显示全部楼层
本帖最后由 lkk0063 于 2018-8-2 11:29 编辑
zjdh 发表于 2018-7-31 19:00
你模拟一个结果看看

你好,
修改后我有发现若跳过O栏位
如红色框框数值会自动往上, 是否能固定住不要往上

00.jpg

Test-1.zip

557.45 KB, 下载次数: 6

回复

使用道具 举报

发表于 2018-8-2 13:03 | 显示全部楼层
你的要求怎么一会儿一变?
回复

使用道具 举报

 楼主| 发表于 2018-8-2 13:05 | 显示全部楼层
zjdh 发表于 2018-8-2 13:03
你的要求怎么一会儿一变?

你好,
不好意思, 没说清楚要求, 因为档案有多个不一样需求, 所以我需要依照档案变化而改变

回复

使用道具 举报

发表于 2018-8-2 18:47 | 显示全部楼层
那就给你一个灵活一点的吧。
test3.rar (290.78 KB, 下载次数: 15)
回复

使用道具 举报

 楼主| 发表于 2018-8-3 14:06 | 显示全部楼层
zjdh 发表于 2018-8-2 18:47
那就给你一个灵活一点的吧。

你好,
这个还不错用,可以自行选择所需要的尺寸,谢谢帮忙

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 18:57 , Processed in 0.321841 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表