取得指定範圍內的各k值 - Excel程式區

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

12^#

發表於 2021-7-22 14:56 | 只看該作者

Sub TEST()
Dim xS As Worksheet, xD, Arr(6), Brr, R&, i&, j%, k%, x%, N%, T$
Set xD = CreateObject("Scripting.Dictionary")
For Each xS In Sheets(Array("準2進3", "準3進4", "準4進5", "準5進6", "準6進7", "準7進8"))
xD.RemoveAll
R = xS.[ac65536].End(xlUp).Row - 1
N = N + 1: If R < 1 Then GoTo s01
ReDim Brr(1 To R - 1, 1 To 7)
For k = 0 To N
      Arr(k) = xS.[ae2].Cells(1, k * 9 + 1).Resize(R, 7)
      For j = 1 To 7
         xD(Arr(k)(R, j) & "|" & k) = 1
      Next j
Next k
'--------------------------------------
For i = 1 To R - 1
For j = 1 To 7
      For x = 0 To 48
      For k = 0 To N
         T = (Arr(k)(i, j) + x) Mod 49 & "|" & k
         If xD(T) = 0 Then GoTo x001
      Next k
         Brr(i, j) = Brr(i, j) & IIf(Brr(i, j) = "", "", ",") & x
x001: Next x
Next j
Next i
'-------------------------------------
With xS.[v2].Resize(R - 1, 7)
      .NumberFormatLocal = "@"
      .Value = Brr
End With
s01: Next
End Sub

說明亂, 也亂寫一通~~

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

13^#

發表於 2021-7-22 15:00 | 只看該作者

回復 11# samwang
2016版打不開
不好意思~給您添麻煩^^"

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

14^#

發表於 2021-7-22 15:18 | 只看該作者

回復 12# 准提部林
測試成功

謝謝您一再的幫忙和指導。
感恩

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

15^#

發表於 2021-7-22 20:47 | 只看該作者

回復 11# samwang

取得指定範圍內的各k值_samwang.rar (82.83 KB)
我把二個貴解程式碼分別放在Module1和Module3
整理後，Module1還是顯示不出V2:AB26的答案；Module3的A4:A52的答案就OK了!
可否煩請您再賜正?
謝謝您

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

16^#

發表於 2021-7-22 21:25 | 只看該作者

回復 15# ziv976688

請再測試看看，謝謝

取得指定範圍內的各k值_0722.zip (106.42 KB)

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

17^#

發表於 2021-7-22 21:36 | 只看該作者

回復 12# 准提部林

准大寫的很太精簡，只用了一個數組和字典就搞定多個工作表資料，之前已有看過字典同時裝入不一樣的資料
這次又學到數組也可以這樣使用，真的是一個很好的範例學習了，感謝分享。

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

18^#

發表於 2021-7-22 22:10 | 只看該作者

回復 16# samwang
測試成功

謝謝您的耐心指導和幫忙

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

19^#

發表於 2021-7-28 00:53 | 只看該作者

本帖最後由 ziv976688 於 2021-7-28 01:07 編輯

回復 12# 准提部林

取得指定範圍內的各x值_(減法).rar (88.66 KB)   =>可按清除鍵~重新測試。
版主 : 您好!
請教您~
Module 2
如果要把列20  T = (Arr(k)(i, j) + x) Mod 49 & "|" & k
改為 -x
然後有二種方式的計算狀況 :
A式 : 當 -x之後的差值為負數時，則T自動轉為正數(即如=絕對值)
EX : 準2進3!V2=
IF(OR(IF(MOD(ABS(AE2-x),49),MOD(ABS(AE2-x),49),49)=($AE$27:$AK$27))*OR(IF(MOD(ABS(AN2-x),49),MOD(ABS(AN2-x),49),49)=($AN$27:$AT$27)),x,"")
右拉再下拉填滿
EX :  W2=11；X2=37

B式 : 當 -x之後的差值為負數時，則b]T自動再+49轉為正數(即如=一般的函數計算)
EX : 準2進3!V2=
IF(OR(IF(MOD(AE2-x,49),MOD(AE2-x,49),49)=($AE$27:$AK$27))*OR(IF(MOD(AN2-x,49),MOD(AN2-x,49),49)=($AN$27:$AT$27)),x,"")
右拉再下拉填滿
EX :  V2=23；X2=48

以上二種的計算方式之程式碼~懇請指導。
謝謝您^^

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

20^#

發表於 2021-7-28 11:02 | 只看該作者

回復 19# ziv976688

1)
T = ABS((Arr(k)(i, j) - x) Mod 49) & "|" & k

2)
V=(Arr(k)(i, j) - x) Mod 49
IF V<0 THEN V=V+49
T=V & "|" & K